No OneTemporary
Actions

Size

5 MB

Subscribers

None

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.

	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_CAT.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_CAT.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_CAT.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_CAT.thy
	@@ -1,156 +1,156 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>CAT\<close> as a digraph\label{sec:dg_CAT}\<close>
	theory CZH_DG_CAT
	imports
	CZH_ECAT_Functor
	CZH_ECAT_Small_Category
	begin



	subsection\<open>Background\<close>


	text\<open>
	\<open>CAT\<close> is usually defined as a category of categories and functors
	(e.g., see Chapter I-2 in \cite{mac_lane_categories_2010}).
	However, there is little that can prevent one from exposing \<open>CAT\<close>
	as a digraph and provide additional structure gradually in
	subsequent theories.
	Thus, in this section, \<open>\<alpha>\<close>-\<open>CAT\<close> is defined as a digraph of categories
	and functors in the set \<open>V\<^sub>\<alpha>\<close>, and \<open>\<alpha>\<close>-\<open>Cat\<close> is defined
	as a digraph of tiny categories and tiny functors in \<open>V\<^sub>\<alpha>\<close>.
	\<close>

	named_theorems dg_CAT_simps
	named_theorems dg_CAT_intros



	subsection\<open>Definition and elementary properties\<close>

	definition dg_CAT :: "V \<Rightarrow> V"
	where "dg_CAT \<alpha> =
	[
	set {\<CC>. category \<alpha> \<CC>},
	all_cfs \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_CAT_components:
	shows "dg_CAT \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. category \<alpha> \<CC>}"
	and "dg_CAT \<alpha>\<lparr>Arr\<rparr> = all_cfs \<alpha>"
	and "dg_CAT \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "dg_CAT \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	unfolding dg_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)



	subsection\<open>Object\<close>

	lemma dg_CAT_ObjI:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	using assms unfolding dg_CAT_components by auto

	lemma dg_CAT_ObjD:
	assumes "\<AA> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	shows "category \<alpha> \<AA>"
	using assms unfolding dg_CAT_components by auto

	lemma dg_CAT_ObjE:
	assumes "\<AA> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	obtains "category \<alpha> \<AA>"
	using assms unfolding dg_CAT_components by auto

	lemma dg_CAT_Obj_iff[dg_CAT_simps]: "\<AA> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> category \<alpha> \<AA>"
	unfolding dg_CAT_components by auto



	subsection\<open>Domain and codomain\<close>

	lemma [dg_CAT_simps]:
	assumes "\<FF> \<in>\<^sub>\<circ> all_cfs \<alpha>"
	shows dg_CAT_Dom_app: "dg_CAT \<alpha>\<lparr>Dom\<rparr>\<lparr>\<FF>\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	and dg_CAT_Cod_app: "dg_CAT \<alpha>\<lparr>Cod\<rparr>\<lparr>\<FF>\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	using assms unfolding dg_CAT_components by auto



	subsection\<open>\<open>CAT\<close> is a digraph\<close>

	lemma (in \<Z>) tiny_category_dg_CAT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_digraph \<beta> (dg_CAT \<alpha>)"
	proof(intro tiny_digraphI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "vfsequence (dg_CAT \<alpha>)" unfolding dg_CAT_def by simp
	show "vcard (dg_CAT \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_CAT_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_CAT \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	proof(intro vsubsetI)
	fix \<AA> assume "\<AA> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (dg_CAT \<alpha>\<lparr>Dom\<rparr>)"
	then obtain \<FF> where "\<FF> \<in>\<^sub>\<circ> all_cfs \<alpha>" and "\<AA> = \<FF>\<lparr>HomDom\<rparr>"
	unfolding dg_CAT_components by auto
	then obtain \<BB> \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding dg_CAT_components by auto
	then interpret is_functor \<alpha> \<AA> \<BB> \<FF> by simp
	show "\<AA> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	by (simp add: dg_CAT_components HomDom.category_axioms)
	qed
	show "\<R>\<^sub>\<circ> (dg_CAT \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	proof(intro vsubsetI)
	fix \<BB> assume "\<BB> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (dg_CAT \<alpha>\<lparr>Cod\<rparr>)"
	then obtain \<FF> where "\<FF> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (dg_CAT \<alpha>\<lparr>Cod\<rparr>)" and "\<BB> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding dg_CAT_components by auto
	then obtain \<AA> \<FF>
	- where dghm: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and \<BB>_def: "\<BB> = \<FF>\<lparr>HomCod\<rparr>"
	+ where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and \<BB>_def: "\<BB> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding dg_CAT_components by auto
	have "\<BB> = \<FF>\<lparr>HomCod\<rparr>" unfolding \<BB>_def by simp
	- interpret is_functor \<alpha> \<AA> \<BB> \<FF> by (rule dghm)
	+ interpret is_functor \<alpha> \<AA> \<BB> \<FF> by (rule \<FF>)
	show "\<BB> \<in>\<^sub>\<circ> dg_CAT \<alpha>\<lparr>Obj\<rparr>"
	by (simp add: HomCod.category_axioms dg_CAT_components)
	qed
	show "dg_CAT \<alpha>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_CAT_components by (rule categories_in_Vset[OF assms])
	show "dg_CAT \<alpha>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_CAT_components by (rule all_cfs_in_Vset[OF assms])
	qed (simp_all add: assms dg_CAT_components)



	subsection\<open>Arrow with a domain and a codomain\<close>

	lemma dg_CAT_is_arrI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<^bsub>dg_CAT \<alpha>\<^esub> \<BB>"
	proof(intro is_arrI, unfold dg_CAT_components(2))
	interpret is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms)
	from assms show "\<FF> \<in>\<^sub>\<circ> all_cfs \<alpha>" by auto
	with assms show "dg_CAT \<alpha>\<lparr>Dom\<rparr>\<lparr>\<FF>\<rparr> = \<AA>" "dg_CAT \<alpha>\<lparr>Cod\<rparr>\<lparr>\<FF>\<rparr> = \<BB>"
	by (simp_all add: dg_CAT_components cat_cs_simps)
	qed

	lemma dg_CAT_is_arrD:
	assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_CAT \<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (elim is_arrE) (auto simp: dg_CAT_components)

	lemma dg_CAT_is_arrE:
	assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_CAT \<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (simp add: dg_CAT_is_arrD)

	lemma dg_CAT_is_arr_iff[dg_CAT_simps]:
	"\<FF> : \<AA> \<mapsto>\<^bsub>dg_CAT \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto intro: dg_CAT_is_arrI dest: dg_CAT_is_arrD)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_FUNCT.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_FUNCT.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_FUNCT.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_DG_FUNCT.thy
	@@ -1,1441 +1,1467 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>FUNCT\<close> and \<open>Funct\<close> as digraphs\label{sec:dg_FUNCT}\<close>
	theory CZH_DG_FUNCT
	imports
	CZH_ECAT_Small_NTCF
	CZH_Foundations.CZH_DG_Subdigraph
	begin



	subsection\<open>Background\<close>


	text\<open>
	A general reference for this section is Chapter II-4 in
	\cite{mac_lane_categories_2010}.
	\<close>

	named_theorems dg_FUNCT_cs_simps
	named_theorems dg_FUNCT_cs_intros
	named_theorems cat_map_cs_simps
	named_theorems cat_map_cs_intros
	+named_theorems cat_map_extra_cs_simps



	subsection\<open>Functor map\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_map :: "V \<Rightarrow> V"
	where "cf_map \<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>]\<^sub>\<circ>"

	abbreviation cf_maps :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_maps \<alpha> \<AA> \<BB> \<equiv> set {cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation tm_cf_maps :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "tm_cf_maps \<alpha> \<AA> \<BB> \<equiv> set {cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemma tm_cf_maps_subset_cf_maps:
	"{cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq> {cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by auto


	text\<open>Components.\<close>

	lemma cf_map_components[cat_map_cs_simps]:
	shows "cf_map \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "cf_map \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	unfolding cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Sequence characterization.\<close>

	lemma dg_FUNCT_Obj_components:
	shows "[FOM, FAM]\<^sub>\<circ>\<lparr>ObjMap\<rparr> = FOM"
	and "[FOM, FAM]\<^sub>\<circ>\<lparr>ArrMap\<rparr> = FAM"
	unfolding dghm_field_simps by (simp_all add: nat_omega_simps)

	lemma cf_map_vfsequence[cat_map_cs_intros]: "vfsequence (cf_map \<FF>)"
	unfolding cf_map_def by auto

	lemma cf_map_vdomain[cat_map_cs_simps]: "\<D>\<^sub>\<circ> (cf_map \<FF>) = 2\<^sub>\<nat>"
	unfolding cf_map_def by (simp add: nat_omega_simps)

	lemma (in is_functor) cf_map_vsubset_cf: "cf_map \<FF> \<subseteq>\<^sub>\<circ> \<FF>"
	by (unfold cf_map_def, subst (3) cf_def)
	(cs_concl cs_shallow cs_intro: vcons_vsubset' V_cs_intros)


	text\<open>Size.\<close>

	lemma (in is_functor) cf_map_ObjMap_in_Vset:
	assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_map \<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms unfolding cf_map_components by (intro cf_ObjMap_in_Vset)

	lemma (in is_tm_functor) tm_cf_map_ObjMap_in_Vset: "cf_map \<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding cf_map_components by (rule tm_cf_ObjMap_in_Vset)

	lemma (in is_functor) cf_map_ArrMap_in_Vset:
	assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_map \<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms unfolding cf_map_components by (intro cf_ArrMap_in_Vset)

	lemma (in is_tm_functor) tm_cf_map_ArrMap_in_Vset: "cf_map \<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding cf_map_components by (rule tm_cf_ArrMap_in_Vset)

	lemma (in is_functor) cf_map_in_Vset_4: "cf_map \<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], cat_cs_intros] =
	cf_ObjMap_vsubset_Vset
	cf_ArrMap_vsubset_Vset
	show ?thesis
	by (subst cf_map_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps
	cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma (in is_tm_functor) tm_cf_map_in_Vset: "cf_map \<FF> \<in>\<^sub>\<circ> Vset \<alpha>"
	using tm_cf_ObjMap_in_Vset tm_cf_ArrMap_in_Vset unfolding cf_map_def
	by (cs_concl cs_shallow cs_intro: V_cs_intros)

	lemma (in is_functor) cf_map_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_map \<FF> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms cf_map_in_Vset_4 cf_map_vsubset_cf
	by (auto intro!: cf_in_Vset)

	lemma cf_maps_subset_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "{cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq> elts (Vset \<beta>)"
	proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	fix x \<FF> assume x_def: "x = cf_map \<FF>" and \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	interpret is_functor \<alpha> \<AA> \<BB> \<FF> by (rule \<FF>)
	show "x \<in>\<^sub>\<circ> Vset \<beta>" unfolding x_def by (rule cf_map_in_Vset[OF assms])
	qed

	lemma small_cf_maps[simp]: "small {cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_functor.cf_map_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma small_tm_cf_maps[simp]: "small {cf_map \<FF> \| \<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule smaller_than_small[OF small_cf_maps tm_cf_maps_subset_cf_maps])

	lemma (in \<Z>) cf_maps_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_maps \<alpha> \<AA> \<BB> \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "cf_maps \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<AA> \<BB> \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>: "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	interpret is_functor \<alpha> \<AA> \<BB> \<FF>' using \<FF> by simp
	show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)" unfolding \<FF>_def by (rule cf_map_in_Vset_4)
	qed
	from assms(2) show "Vset (\<alpha> + 4\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma (in \<Z>) tm_cf_maps_vsubset_Vset: "tm_cf_maps \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<AA> \<BB> \<FF>'
	where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>: "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	then show "\<FF> \<in>\<^sub>\<circ> Vset \<alpha>" by (force simp: is_tm_functor.tm_cf_map_in_Vset)
	qed


	text\<open>Rules.\<close>

	lemma (in is_functor) cf_mapsI: "cf_map \<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	by (auto intro: cat_cs_intros)

	lemma (in is_tm_functor) tm_cf_mapsI: "cf_map \<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	by (auto intro: cat_small_cs_intros)

	lemma (in is_functor) cf_mapsI':
	assumes "\<FF>' = cf_map \<FF>"
	shows "\<FF>' \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	unfolding assms by (rule cf_mapsI)

	lemma (in is_tm_functor) tm_cf_mapsI':
	assumes "\<FF>' = cf_map \<FF>"
	shows "\<FF>' \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	unfolding assms by (rule tm_cf_mapsI)

	lemmas [cat_map_cs_intros] =
	is_functor.cf_mapsI

	lemmas cf_mapsI'[cat_map_cs_intros] =
	is_functor.cf_mapsI'[rotated]

	lemmas [cat_map_cs_intros] =
	is_tm_functor.tm_cf_mapsI

	lemmas tm_cf_mapsI'[cat_map_cs_intros] =
	is_tm_functor.tm_cf_mapsI'[rotated]

	lemma cf_mapsE[elim]:
	assumes "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	obtains \<GG> where "\<FF> = cf_map \<GG>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by force

	lemma tm_cf_mapsE[elim]:
	assumes "\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	obtains \<GG> where "\<FF> = cf_map \<GG>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by force


	text\<open>The opposite functor map.\<close>

	lemma (in is_functor) cf_map_op_cf[cat_op_simps]: "cf_map (op_cf \<FF>) = cf_map \<FF>"
	proof(rule vsv_eqI, unfold cat_map_cs_simps)
	show "a \<in>\<^sub>\<circ> 2\<^sub>\<nat> \<Longrightarrow> cf_map (op_cf \<FF>)\<lparr>a\<rparr> = cf_map \<FF>\<lparr>a\<rparr>" for a
	by
	(
	elim_in_numeral,
	unfold dghm_field_simps[symmetric] cf_map_components cat_op_simps
	)
	simp_all
	qed (auto intro: cat_map_cs_intros)

	lemmas [cat_op_simps] = is_functor.cf_map_op_cf


	text\<open>Elementary properties.\<close>

	lemma tm_cf_maps_vsubset_cf_maps: "tm_cf_maps \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	using tm_cf_maps_subset_cf_maps by simp

	lemma tm_cf_maps_in_cf_maps:
	assumes "\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	shows "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	using assms tm_cf_maps_vsubset_cf_maps[of \<alpha> \<AA> \<BB>] by blast

	lemma cf_map_inj:
	assumes "cf_map \<FF> = cf_map \<GG>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> = \<GG>"
	proof(rule cf_eqI)
	from assms(1) have ObjMap: "cf_map \<FF>\<lparr>ObjMap\<rparr> = cf_map \<GG>\<lparr>ObjMap\<rparr>"
	and ArrMap: "cf_map \<FF>\<lparr>ArrMap\<rparr> = cf_map \<GG>\<lparr>ArrMap\<rparr>"
	by auto
	from ObjMap show "\<FF>\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr>" unfolding cf_map_components by simp
	from ArrMap show "\<FF>\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr>" unfolding cf_map_components by simp
	qed (auto intro: assms(2,3))

	lemma cf_map_eq_iff[cat_map_cs_simps]:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "cf_map \<FF> = cf_map \<GG> \<longleftrightarrow> \<FF> = \<GG>"
	using cf_map_inj[OF _ assms] by auto

	lemma cf_map_eqI:
	assumes "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	and "\<GG> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	and "\<FF>\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr>"
	shows "\<FF> = \<GG>"
	proof-
	from assms(1) obtain \<FF>'
	where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from assms(2) obtain \<GG>'
	where \<GG>_def: "\<GG> = cf_map \<GG>'" and \<GG>': "\<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	show ?thesis
	proof(rule vsv_eqI, unfold \<FF>_def \<GG>_def)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cf_map \<FF>') \<Longrightarrow> cf_map \<FF>'\<lparr>a\<rparr> = cf_map \<GG>'\<lparr>a\<rparr>" for a
	by
	(
	unfold cf_map_vdomain,
	elim_in_numeral,
	insert assms(3,4),
	unfold \<FF>_def \<GG>_def
	)
	(auto simp: dghm_field_simps)
	qed (auto simp: cat_map_cs_simps intro: cat_map_cs_intros)
	qed



	subsection\<open>Conversion of a functor map to a functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_of_cf_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_of_cf_map \<AA> \<BB> \<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<AA>, \<BB>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	-lemma cf_of_cf_map_components[cat_map_cs_simps]:
	+lemma cf_of_cf_map_components:
	shows "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>HomCod\<rparr> = \<BB>"
	unfolding cf_of_cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)

	+lemmas [cat_map_extra_cs_simps] = cf_of_cf_map_components(1-2)
	+lemmas [cat_map_cs_simps] = cf_of_cf_map_components(3-4)
	+

	subsubsection\<open>The conversion of a functor map to a functor is a functor\<close>

	lemma (in is_functor) cf_of_cf_map_is_functor:
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(rule is_functorI')
	show "vfsequence (cf_of_cf_map \<AA> \<BB> (cf_map \<FF>))"
	unfolding cf_of_cf_map_def by simp
	show "vcard (cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)) = 4\<^sub>\<nat>"
	unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub>
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for a b f
	unfolding cf_of_cf_map_components cf_map_components
	using is_functor_axioms that
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> =
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub>
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for b c g a f
	using is_functor_axioms that
	unfolding cf_of_cf_map_components cf_map_components
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<BB>\<lparr>CId\<rparr>\<lparr>cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for c
	using is_functor_axioms that
	unfolding cf_of_cf_map_components cf_map_components
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	qed
	(
	auto simp:
	cat_cs_simps
	cf_of_cf_map_components
	cf_map_components
	cf_ObjMap_vrange
	intro: cat_cs_intros
	)

	lemma (in is_functor) cf_of_cf_map_is_functor':
	assumes "\<FF>' = cf_map \<FF>"
	and "\<AA>' = \<AA>"
	and "\<BB>' = \<BB>"
	shows "cf_of_cf_map \<AA> \<BB> \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule cf_of_cf_map_is_functor)

	lemmas [cat_map_cs_intros] = is_functor.cf_of_cf_map_is_functor'


	subsubsection\<open>The value of the conversion of a functor map to a functor\<close>

	lemma (in is_functor) cf_of_cf_map_of_cf_map[cat_map_cs_simps]:
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>) = \<FF>"
	proof(rule cf_eqI)
	show "cf_of_cf_map \<AA> \<BB> (cf_map \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(rule is_functorI')
	show "vfsequence (cf_of_cf_map \<AA> \<BB> (cf_map \<FF>))"
	unfolding cf_of_cf_map_def by auto
	show "vcard (cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)) = 4\<^sub>\<nat>"
	unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub>
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for a b f
	unfolding cf_of_cf_map_components cf_map_components
	using is_functor_axioms that
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> =
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub>
	cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for b c g a f
	unfolding cf_of_cf_map_components cf_map_components
	using is_functor_axioms that
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<BB>\<lparr>CId\<rparr>\<lparr>cf_of_cf_map \<AA> \<BB> (cf_map \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for c
	unfolding cf_of_cf_map_components cf_map_components
	using is_functor_axioms that
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	qed
	(
	auto simp:
	cat_cs_simps
	cf_of_cf_map_components
	cf_map_components
	cf_ObjMap_vrange
	intro: cat_cs_intros
	)
	qed (auto simp: cf_of_cf_map_components cf_map_components intro: cat_cs_intros)

	lemmas [cat_map_cs_simps] = is_functor.cf_of_cf_map_of_cf_map



	subsection\<open>Natural transformation arrow\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition ntcf_arrow :: "V \<Rightarrow> V"
	where "ntcf_arrow \<NN> = [\<NN>\<lparr>NTMap\<rparr>, cf_map (\<NN>\<lparr>NTDom\<rparr>), cf_map (\<NN>\<lparr>NTCod\<rparr>)]\<^sub>\<circ>"

	abbreviation ntcf_arrows :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_arrows \<alpha> \<AA> \<BB> \<equiv>
	set {ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation tm_ntcf_arrows :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "tm_ntcf_arrows \<alpha> \<AA> \<BB> \<equiv>
	set {ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemma tm_ntcf_arrows_subset_ntcf_arrows:
	"{ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
	{ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by auto


	text\<open>Components.\<close>

	lemma ntcf_arrow_components:
	shows [cat_map_cs_simps]: "ntcf_arrow \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and "ntcf_arrow \<NN>\<lparr>NTDom\<rparr> = cf_map (\<NN>\<lparr>NTDom\<rparr>)"
	and "ntcf_arrow \<NN>\<lparr>NTCod\<rparr> = cf_map (\<NN>\<lparr>NTCod\<rparr>)"
	unfolding ntcf_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)

	lemma (in is_ntcf) ntcf_arrow_components':
	shows "ntcf_arrow \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and "ntcf_arrow \<NN>\<lparr>NTDom\<rparr> = cf_map \<FF>"
	and "ntcf_arrow \<NN>\<lparr>NTCod\<rparr> = cf_map \<GG>"
	unfolding ntcf_arrow_components ntcf_NTDom ntcf_NTCod by simp_all

	lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_components'(2,3)


	text\<open>Elementary properties.\<close>

	lemma dg_FUNCT_Arr_components:
	shows "[NTM, NTD, NTC]\<^sub>\<circ>\<lparr>NTMap\<rparr> = NTM"
	and "[NTM, NTD, NTC]\<^sub>\<circ>\<lparr>NTDom\<rparr> = NTD"
	and "[NTM, NTD, NTC]\<^sub>\<circ>\<lparr>NTCod\<rparr> = NTC"
	unfolding nt_field_simps by (simp_all add: nat_omega_simps)

	lemma ntcf_arrow_vfsequence[cat_map_cs_intros]: "vfsequence (ntcf_arrow \<NN>)"
	unfolding ntcf_arrow_def by simp

	lemma ntcf_arrow_vdomain[cat_map_cs_simps]: "\<D>\<^sub>\<circ> (ntcf_arrow \<NN>) = 3\<^sub>\<nat>"
	unfolding ntcf_arrow_def by (simp add: nat_omega_simps)


	text\<open>Size.\<close>

	lemma (in is_ntcf) ntcf_arrow_NTMap_in_Vset:
	assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_arrow \<NN>\<lparr>NTMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms unfolding ntcf_arrow_components by (intro ntcf_NTMap_in_Vset)

	lemma (in is_tm_ntcf) tm_ntcf_arrow_NTMap_in_Vset:
	"ntcf_arrow \<NN>\<lparr>NTMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding ntcf_arrow_components by (rule tm_ntcf_NTMap_in_Vset)

	lemma (in is_ntcf) ntcf_arrow_NTDom_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_arrow \<NN>\<lparr>NTDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms unfolding ntcf_arrow_components' by (rule NTDom.cf_map_in_Vset)

	lemma (in is_tm_ntcf) tm_ntcf_arrow_NTDom_in_Vset:
	"ntcf_arrow \<NN>\<lparr>NTDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding ntcf_arrow_components' by (rule NTDom.tm_cf_map_in_Vset)

	lemma (in is_ntcf) ntcf_arrow_NTCod_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_arrow \<NN>\<lparr>NTCod\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms unfolding ntcf_arrow_components' by (rule NTCod.cf_map_in_Vset)

	lemma (in is_tm_ntcf) tm_ntcf_arrow_NTCod_in_Vset:
	"ntcf_arrow \<NN>\<lparr>NTCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding ntcf_arrow_components' by (rule NTCod.tm_cf_map_in_Vset)

	lemma (in is_ntcf) ntcf_arrow_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_arrow \<NN> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret ntcf_arrow: vfsequence \<open>ntcf_arrow \<NN>\<close>
	by (auto intro: cat_map_cs_intros)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show ?thesis
	proof(rule vsv.vsv_Limit_vsv_in_VsetI)
	from assms show "\<D>\<^sub>\<circ> (ntcf_arrow \<NN>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (auto simp: cat_map_cs_simps)
	have "n \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_arrow \<NN>) \<Longrightarrow> ntcf_arrow \<NN>\<lparr>n\<rparr> \<in>\<^sub>\<circ> Vset \<beta>" for n
	by
	(
	unfold ntcf_arrow_vdomain,
	elim_in_numeral,
	all\<open>rewrite in "\<hole> \<in>\<^sub>\<circ> _" nt_field_simps[symmetric]\<close>,
	insert assms,
	unfold ntcf_arrow_components'
	)
	(
	auto intro:
	ntcf_NTMap_in_Vset NTDom.cf_map_in_Vset NTCod.cf_map_in_Vset
	)
	with ntcf_arrow.vsv_vrange_vsubset show "\<R>\<^sub>\<circ> (ntcf_arrow \<NN>) \<subseteq>\<^sub>\<circ> Vset \<beta>"
	by simp
	qed (auto simp: cat_map_cs_simps)
	qed

	lemma (in is_tm_ntcf) tm_ntcf_arrow_in_Vset: "ntcf_arrow \<NN> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	interpret tm_ntcf_arrow: vfsequence \<open>ntcf_arrow \<NN>\<close>
	by (auto intro: cat_map_cs_intros)
	show ?thesis
	proof(rule vsv.vsv_Limit_vsv_in_VsetI)
	have "n \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_arrow \<NN>) \<Longrightarrow> ntcf_arrow \<NN>\<lparr>n\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" for n
	by
	(
	unfold ntcf_arrow_vdomain,
	elim_in_numeral,
	all\<open>rewrite in "\<hole> \<in>\<^sub>\<circ> _" nt_field_simps[symmetric]\<close>
	)
	(
	intro tm_ntcf_arrow_NTMap_in_Vset
	tm_ntcf_arrow_NTDom_in_Vset
	tm_ntcf_arrow_NTCod_in_Vset
	)+
	with tm_ntcf_arrow.vsv_vrange_vsubset show "\<R>\<^sub>\<circ> (ntcf_arrow \<NN>) \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by auto
	qed (auto simp: cat_map_cs_simps)
	qed

	lemma ntcf_arrows_subset_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows
	"{ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq> elts (Vset \<beta>)"
	proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	fix x \<NN> \<FF> \<GG> assume x_def: "x = ntcf_arrow \<NN>"
	and \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	interpret is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule \<NN>)
	show "x \<in>\<^sub>\<circ> Vset \<beta>" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
	qed

	lemma tm_ntcf_arrows_subset_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows
	"{ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
	elts (Vset \<beta>)"
	proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	fix x \<NN> \<FF> \<GG> assume x_def: "x = ntcf_arrow \<NN>"
	and \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	interpret is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule \<NN>)
	show "x \<in>\<^sub>\<circ> Vset \<beta>" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
	qed

	lemma small_ntcf_arrows[simp]:
	"small {ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_ntcf.ntcf_arrow_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}"
	by auto
	then show ?thesis by simp
	qed

	lemma small_tm_ntcf_arrows[simp]:
	"small {ntcf_arrow \<NN> \| \<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
	by
	(
	rule smaller_than_small[
	OF small_ntcf_arrows tm_ntcf_arrows_subset_ntcf_arrows
	]
	)

	lemma (in is_ntcf) ntcf_arrow_in_Vset_7: "ntcf_arrow \<NN> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], cat_cs_intros] =
	ntcf_NTMap_vsubset_Vset
	from NTDom.cf_map_in_Vset_4 have [cat_cs_intros]:
	"cf_map \<FF> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by succ_of_numeral
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	from NTCod.cf_map_in_Vset_4 have [cat_cs_intros]:
	"cf_map \<GG> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by succ_of_numeral
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	show ?thesis
	by (subst ntcf_arrow_def, succ_of_numeral, unfold cat_cs_simps)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps
	cs_intro: V_cs_intros cat_cs_intros
	)
	qed

	lemma (in \<Z>) ntcf_arrows_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_arrows \<alpha> \<AA> \<BB> \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "ntcf_arrows \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	then obtain \<NN>' \<FF> \<GG>
	where \<NN>_def: "\<NN> = ntcf_arrow \<NN>'"
	and \<NN>': "\<NN>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	interpret is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>' using \<NN>' by simp
	show "\<NN> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" unfolding \<NN>_def by (rule ntcf_arrow_in_Vset_7)
	qed
	from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma (in \<Z>) tm_ntcf_arrows_vsubset_Vset: "tm_ntcf_arrows \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by (clarsimp simp: is_tm_ntcf.tm_ntcf_arrow_in_Vset)


	text\<open>Rules.\<close>

	lemma (in is_ntcf) ntcf_arrowsI: "ntcf_arrow \<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	using is_ntcf_axioms by auto

	lemma (in is_tm_ntcf) tm_ntcf_arrowsI: "ntcf_arrow \<NN> \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	using is_ntcf_axioms by (auto intro: cat_small_cs_intros)

	lemma (in is_ntcf) ntcf_arrowsI':
	assumes "\<NN>' = ntcf_arrow \<NN>"
	shows "\<NN>' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	unfolding assms(1) by (rule ntcf_arrowsI)

	lemma (in is_tm_ntcf) tm_ntcf_arrowsI':
	assumes "\<NN>' = ntcf_arrow \<NN>"
	shows "\<NN>' \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	unfolding assms(1) by (rule tm_ntcf_arrowsI)

	lemmas [cat_map_cs_intros] =
	is_ntcf.ntcf_arrowsI

	lemmas ntcf_arrowsI'[cat_map_cs_intros] =
	is_ntcf.ntcf_arrowsI'[rotated]

	lemmas [cat_map_cs_intros] =
	is_tm_ntcf.tm_ntcf_arrowsI

	lemmas tm_ntcf_arrowsI'[cat_map_cs_intros] =
	is_tm_ntcf.tm_ntcf_arrowsI'[rotated]

	lemma ntcf_arrowsE[elim]:
	assumes "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	obtains \<MM> \<FF> \<GG> where "\<NN> = ntcf_arrow \<MM>" and "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by auto

	lemma tm_ntcf_arrowsE[elim]:
	assumes "\<NN> \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	obtains \<MM> \<FF> \<GG> where "\<NN> = ntcf_arrow \<MM>"
	and "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma tm_ntcf_arrows_vsubset_ntcf_arrows:
	"tm_ntcf_arrows \<alpha> \<AA> \<BB> \<subseteq>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	using tm_ntcf_arrows_subset_ntcf_arrows by auto

	lemma tm_ntcf_arrows_in_cf_arrows[cat_map_cs_intros]:
	assumes "\<NN> \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	shows "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	using assms tm_ntcf_arrows_vsubset_ntcf_arrows[of \<alpha> \<AA> \<BB>] by blast

	lemma ntcf_arrow_inj:
	assumes "ntcf_arrow \<MM> = ntcf_arrow \<NN>"
	and "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> = \<NN>"
	proof(rule ntcf_eqI)
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF>' \<GG>' \<NN> by (rule assms(3))
	from assms(1) have NTMap: "ntcf_arrow \<MM>\<lparr>NTMap\<rparr> = ntcf_arrow \<NN>\<lparr>NTMap\<rparr>"
	and NTDom: "ntcf_arrow \<MM>\<lparr>NTDom\<rparr> = ntcf_arrow \<NN>\<lparr>NTDom\<rparr>"
	and NTCod: "ntcf_arrow \<MM>\<lparr>NTCod\<rparr> = ntcf_arrow \<NN>\<lparr>NTCod\<rparr>"
	by auto
	from NTMap show "\<MM>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>" unfolding ntcf_arrow_components by simp
	from NTDom NTCod show "\<MM>\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>" "\<MM>\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>"
	unfolding ntcf_arrow_components cf_map_components
	by
	(
	auto simp:
	cat_cs_simps
	cf_map_eq_iff[OF \<MM>.NTDom.is_functor_axioms \<NN>.NTDom.is_functor_axioms]
	cf_map_eq_iff[OF \<MM>.NTCod.is_functor_axioms \<NN>.NTCod.is_functor_axioms]
	)
	from assms(2,3) show
	"\<MM> : \<MM>\<lparr>NTDom\<rparr> \<mapsto>\<^sub>C\<^sub>F \<MM>\<lparr>NTCod\<rparr> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	"\<NN> : \<NN>\<lparr>NTDom\<rparr> \<mapsto>\<^sub>C\<^sub>F \<NN>\<lparr>NTCod\<rparr> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto simp: cat_cs_simps)
	qed auto

	lemma ntcf_arrow_eq_iff[cat_map_cs_simps]:
	assumes "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow \<MM> = ntcf_arrow \<NN> \<longleftrightarrow> \<MM> = \<NN>"
	using ntcf_arrow_inj[OF _ assms] by auto

	lemma ntcf_arrow_eqI:
	assumes "\<MM> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	and "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	and "\<MM>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and "\<MM>\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>"
	and "\<MM>\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>"
	shows "\<MM> = \<NN>"
	proof-
	from assms(1) obtain \<MM>' \<FF> \<GG>
	where \<MM>_def: "\<MM> = ntcf_arrow \<MM>'" and \<MM>': "\<MM>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from assms(2) obtain \<NN>' \<FF>' \<GG>'
	where \<NN>_def: "\<NN> = ntcf_arrow \<NN>'" and \<NN>': "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	show ?thesis
	proof(rule vsv_eqI, unfold \<MM>_def \<NN>_def)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_arrow \<MM>') \<Longrightarrow> ntcf_arrow \<MM>'\<lparr>a\<rparr> = ntcf_arrow \<NN>'\<lparr>a\<rparr>"
	for a
	by
	(
	unfold ntcf_arrow_vdomain,
	elim_in_numeral,
	insert assms(3-5),
	unfold \<MM>_def \<NN>_def,
	fold nt_field_simps
	)
	simp_all
	qed (auto intro: cat_map_cs_intros simp: cat_map_cs_simps)
	qed



	subsection\<open>
	Conversion of a natural transformation arrow to a natural transformation
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition ntcf_of_ntcf_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> =
	[
	\<NN>\<lparr>NTMap\<rparr>,
	cf_of_cf_map \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>),
	cf_of_cf_map \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>),
	\<AA>,
	\<BB>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	-lemma ntcf_of_ntcf_arrow_components[cat_map_cs_simps]:
	+lemma ntcf_of_ntcf_arrow_components:
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr> = cf_of_cf_map \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>)"
	and "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr> = cf_of_cf_map \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>)"
	and "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	and "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
	unfolding ntcf_of_ntcf_arrow_def nt_field_simps
	by (simp_all add: nat_omega_simps)

	+lemmas [cat_map_extra_cs_simps] = ntcf_of_ntcf_arrow_components(1)
	+lemmas [cat_map_cs_simps] = ntcf_of_ntcf_arrow_components(2-5)
	+

	subsubsection\<open>
	The conversion of a natural transformation arrow
	to a natural transformation is a natural transformation
	\<close>

	lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf:
	"ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(rule is_ntcfI')
	show "vfsequence (ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>))"
	unfolding ntcf_of_ntcf_arrow_def by auto
	show "vcard (ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>)) = 5\<^sub>\<nat>"
	unfolding ntcf_of_ntcf_arrow_def by (simp add: nat_omega_simps)
	show "ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using is_ntcf_axioms that
	- by (cs_concl cs_shallow cs_simp: cat_map_cs_simps cs_intro: cat_cs_intros)
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_map_cs_simps cat_map_extra_cs_simps
	+ cs_intro: cat_cs_intros
	+ )
	show "ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for a b f
	using is_ntcf_axioms that
	by
	(
	cs_concl cs_shallow
	- cs_simp: ntcf_Comp_commute cat_map_cs_simps cs_intro: cat_cs_intros
	+ cs_simp: ntcf_Comp_commute cat_map_cs_simps cat_map_extra_cs_simps
	+ cs_intro: cat_cs_intros
	)
	-qed (use is_ntcf_axioms in \<open>auto simp: cat_cs_simps cat_map_cs_simps\<close>)
	+qed
	+ (
	+ use is_ntcf_axioms in
	+ \<open>auto simp: cat_cs_simps cat_map_cs_simps cat_map_extra_cs_simps\<close>
	+ )

	lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf':
	assumes "\<NN>' = ntcf_arrow \<NN>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ntcf_of_ntcf_arrow_is_ntcf)

	lemmas [cat_map_cs_intros] = is_ntcf.ntcf_of_ntcf_arrow_is_ntcf'


	subsubsection\<open>
	The composition of the conversion of a natural transformation arrow
	to a natural transformation
	\<close>

	lemma (in is_ntcf) ntcf_of_ntcf_arrow[cat_map_cs_simps]:
	"ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>) = \<NN>"
	by (rule ntcf_eqI)
	- (auto simp: cat_map_cs_simps intro: cat_cs_intros ntcf_of_ntcf_arrow_is_ntcf)
	+ (
	+ auto
	+ simp: cat_map_cs_simps cat_map_extra_cs_simps
	+ intro: cat_cs_intros ntcf_of_ntcf_arrow_is_ntcf
	+ )

	lemmas [cat_map_cs_simps] = is_ntcf.ntcf_of_ntcf_arrow



	subsection\<open>Composition of the natural transformation arrows\<close>

	definition ntcf_arrow_vcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_arrow_vcomp \<AA> \<BB> \<MM> \<NN> =
	ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"

	syntax "_ntcf_arrow_vcomp" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_/ \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>_,_\<^esub> _)\<close> [55, 56, 57, 58] 55)
	translations "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> \<NN>" \<rightleftharpoons> "CONST ntcf_arrow_vcomp \<AA> \<BB> \<MM> \<NN>"


	text\<open>Components.\<close>

	lemma (in is_ntcf) ntcf_arrow_vcomp_components:
	"(ntcf_arrow \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> ntcf_arrow \<NN>)\<lparr>NTMap\<rparr> = (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>"
	"(ntcf_arrow \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> ntcf_arrow \<NN>)\<lparr>NTDom\<rparr> = cf_map ((\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTDom\<rparr>)"
	"(ntcf_arrow \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> ntcf_arrow \<MM>)\<lparr>NTCod\<rparr> = cf_map ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>)\<lparr>NTCod\<rparr>)"
	unfolding
	ntcf_arrow_vcomp_def
	ntsmcf_vcomp_components
	ntcf_arrow_components
	ntcf_of_ntcf_arrow_components
	by (simp_all add: cat_cs_simps cat_map_cs_simps)

	lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_vcomp_components


	text\<open>Elementary properties.\<close>

	lemma ntcf_arrow_vcomp_ntcf_vcomp[cat_map_cs_simps]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> ntcf_arrow \<NN> = ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	by (rule ntcf_arrow_eqI, insert assms)
	(
	cs_concl
	cs_simp: ntcf_arrow_vcomp_def cat_map_cs_simps cat_cs_simps
	cs_intro: cat_map_cs_intros cat_cs_intros
	)+


	subsection\<open>Identity natural transformation arrow\<close>

	definition ntcf_arrow_id :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_arrow_id \<AA> \<BB> \<FF> = ntcf_arrow (ntcf_id (cf_of_cf_map \<AA> \<BB> \<FF>))"


	text\<open>Components.\<close>

	lemma (in is_functor) ntcf_arrow_id_components:
	"(ntcf_arrow_id \<AA> \<BB> (cf_map \<FF>))\<lparr>NTMap\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>"
	"(ntcf_arrow_id \<AA> \<BB> (cf_map \<FF>))\<lparr>NTDom\<rparr> = cf_map (ntcf_id \<FF>\<lparr>NTDom\<rparr>)"
	"(ntcf_arrow_id \<AA> \<BB> (cf_map \<FF>))\<lparr>NTCod\<rparr> = cf_map (ntcf_id \<FF>\<lparr>NTCod\<rparr>)"
	unfolding ntcf_arrow_id_def ntcf_arrow_components
	by (simp_all add: cat_map_cs_simps)

	lemmas [cat_map_cs_simps] = is_functor.ntcf_arrow_id_components


	text\<open>Identity natural transformation arrow is a natural transformation arrow.\<close>

	lemma ntcf_arrow_id_ntcf_id[cat_map_cs_simps]:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow_id \<AA> \<BB> (cf_map \<FF>) = ntcf_arrow (ntcf_id \<FF>)"
	by (rule ntcf_arrow_eqI, insert assms, unfold ntcf_arrow_id_def)
	(
	cs_concl
	cs_simp: cat_map_cs_simps cat_cs_simps
	cs_intro: cat_map_cs_intros cat_cs_intros
	)



	subsection\<open>\<open>FUNCT\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dg_FUNCT :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "dg_FUNCT \<alpha> \<AA> \<BB> =
	[
	cf_maps \<alpha> \<AA> \<BB>,
	ntcf_arrows \<alpha> \<AA> \<BB>,
	(\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>),
	(\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)
	]\<^sub>\<circ>"

	lemmas [dg_FUNCT_cs_simps] = cat_map_cs_simps
	lemmas [dg_FUNCT_cs_intros] = cat_map_cs_intros


	text\<open>Components.\<close>

	lemma dg_FUNCT_components:
	shows "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> = cf_maps \<alpha> \<AA> \<BB>"
	and "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr> = ntcf_arrows \<alpha> \<AA> \<BB>"
	and "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>)"
	and "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)"
	unfolding dg_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Objects\<close>

	lemma (in is_functor) dg_FUNCT_ObjI: "cf_map \<FF> \<in>\<^sub>\<circ> dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	unfolding dg_FUNCT_components by (auto intro: cat_cs_intros)


	subsubsection\<open>Domain and codomain\<close>

	mk_VLambda dg_FUNCT_components(3)
	\|vsv dg_FUNCT_Dom_vsv[dg_FUNCT_cs_intros]\|
	\|vdomain dg_FUNCT_Dom_vdomain[dg_FUNCT_cs_simps]\|

	mk_VLambda dg_FUNCT_components(4)
	\|vsv dg_FUNCT_Cod_vsv[dg_FUNCT_cs_intros]\|
	\|vdomain dg_FUNCT_Cod_vdomain[dg_FUNCT_cs_simps]\|

	lemma (in is_ntcf)
	shows dg_FUNCT_Dom_app: "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	and dg_FUNCT_Cod_app: "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	proof-
	from is_ntcf_axioms show
	"dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	"dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	unfolding dg_FUNCT_components
	by
	(
	cs_concl
	cs_simp: dg_FUNCT_cs_simps V_cs_simps cs_intro: dg_FUNCT_cs_intros
	)+
	qed

	lemma (in is_ntcf)
	assumes "\<NN>' = ntcf_arrow \<NN>"
	shows dg_FUNCT_Dom_app': "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>\<NN>'\<rparr> = cf_map \<FF>"
	and dg_FUNCT_Cod_app': "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>\<NN>'\<rparr> = cf_map \<GG>"
	unfolding assms by (intro dg_FUNCT_Dom_app dg_FUNCT_Cod_app)+

	lemmas [dg_FUNCT_cs_simps] =
	is_ntcf.dg_FUNCT_Dom_app'
	is_ntcf.dg_FUNCT_Cod_app'

	lemma
	shows dg_FUNCT_Dom_vrange: "\<R>\<^sub>\<circ> (dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	and dg_FUNCT_Cod_vrange: "\<R>\<^sub>\<circ> (dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	unfolding dg_FUNCT_components
	proof(all\<open>intro vrange_VLambda_vsubset\<close>)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	then obtain \<MM> \<FF> \<GG> where \<NN>_def[dg_FUNCT_cs_simps]: "\<NN> = ntcf_arrow \<MM>"
	and \<MM>: "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<MM> show "\<NN>\<lparr>NTDom\<rparr> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros)
	from \<MM> show "\<NN>\<lparr>NTCod\<rparr> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros
	)
	qed


	subsubsection\<open>\<open>FUNCT\<close> is a tiny digraph\<close>

	lemma (in \<Z>) tiny_digraph_dg_FUNCT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_digraph \<beta> (dg_FUNCT \<alpha> \<AA> \<BB>)"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show ?thesis
	proof(intro tiny_digraphI)
	show "vfsequence (dg_FUNCT \<alpha> \<AA> \<BB>)" unfolding dg_FUNCT_def by simp
	show "vcard (dg_FUNCT \<alpha> \<AA> \<BB>) = 4\<^sub>\<nat>"
	unfolding dg_FUNCT_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
	show "\<R>\<^sub>\<circ> (dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
	from assms show "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_FUNCT_components(1) by (rule cf_maps_in_Vset)
	show "dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_FUNCT_components(2) by (rule ntcf_arrows_in_Vset[OF assms])
	qed (auto simp: dg_FUNCT_cs_simps dg_FUNCT_components(1,2) intro: dg_FUNCT_cs_intros)
	qed


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma dg_FUNCT_is_arrI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>dg_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	proof(intro is_arrI, unfold dg_FUNCT_components(1,2))
	interpret is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms)
	from assms show "ntcf_arrow \<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>" by auto
	from assms show
	"dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	"dg_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	by (cs_concl cs_shallow cs_simp: dg_FUNCT_cs_simps)+
	qed

	lemma dg_FUNCT_is_arrI':
	assumes "\<NN>' = ntcf_arrow \<NN>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = cf_map \<FF>"
	and "\<GG>' = cf_map \<GG>"
	shows "\<NN>' : \<FF>' \<mapsto>\<^bsub>dg_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>'"
	using assms(2) unfolding assms(1,3,4) by (rule dg_FUNCT_is_arrI)

	lemmas [dg_FUNCT_cs_intros] = dg_FUNCT_is_arrI'

	lemma dg_FUNCT_is_arrD[dest]:
	assumes "\<NN> : \<FF> \<mapsto>\<^bsub>dg_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	proof-
	note \<NN> = is_arrD[OF assms, unfolded dg_FUNCT_components(2)]
	obtain \<NN>' \<FF>' \<GG>' where \<NN>_def: "\<NN> = ntcf_arrow \<NN>'"
	and \<NN>': "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (elim ntcf_arrowsE[OF \<NN>(1)])
	from \<NN>(2) \<NN>' have \<FF>_def: "\<FF> = cf_map \<FF>'"
	by (cs_prems cs_simp: \<NN>_def dg_FUNCT_cs_simps) simp
	from \<NN>(3) \<NN>' have \<GG>_def: "\<GG> = cf_map \<GG>'"
	by (cs_prems cs_simp: \<NN>_def dg_FUNCT_cs_simps) simp
	from \<NN>' have \<NN>'_def: "\<NN>' = ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>"
	unfolding \<NN>_def by (cs_concl cs_shallow cs_simp: dg_FUNCT_cs_simps)
	from \<NN>' have \<FF>'_def: "\<FF>' = cf_of_cf_map \<AA> \<BB> \<FF>"
	and \<GG>'_def: "\<GG>' = cf_of_cf_map \<AA> \<BB> \<GG>"
	unfolding \<FF>_def \<GG>_def
	by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: cat_cs_intros)+
	from \<NN>' show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by (fold \<FF>'_def \<GG>'_def \<NN>'_def \<FF>_def \<GG>_def \<NN>_def) simp_all
	qed

	lemma dg_FUNCT_is_arrE[elim]:
	assumes "\<NN> : \<FF> \<mapsto>\<^bsub>dg_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	obtains \<NN>' \<FF>' \<GG>'
	where "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow \<NN>'"
	and "\<FF> = cf_map \<FF>'"
	and "\<GG> = cf_map \<GG>'"
	using dg_FUNCT_is_arrD[OF assms] by auto



	subsection\<open>\<open>Funct\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dg_Funct :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "dg_Funct \<alpha> \<AA> \<BB> =
	[
	tm_cf_maps \<alpha> \<AA> \<BB>,
	tm_ntcf_arrows \<alpha> \<AA> \<BB>,
	(\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>),
	(\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_Funct_components:
	shows "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> = tm_cf_maps \<alpha> \<AA> \<BB>"
	and "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr> = tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	and "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>)"
	and "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)"
	unfolding dg_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Objects\<close>

	lemma (in is_tm_functor) dg_Funct_ObjI: "cf_map \<FF> \<in>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	unfolding dg_Funct_components by (auto simp: cat_small_cs_intros)


	subsubsection\<open>Domain and codomain\<close>

	mk_VLambda dg_Funct_components(3)
	\|vsv dg_Funct_Dom_vsv[dg_FUNCT_cs_intros]\|
	\|vdomain dg_Funct_Dom_vdomain[dg_FUNCT_cs_simps]\|

	mk_VLambda dg_Funct_components(4)
	\|vsv dg_Funct_Cod_vsv[dg_FUNCT_cs_intros]\|
	\|vdomain dg_Funct_Cod_vdomain[dg_FUNCT_cs_simps]\|

	lemma (in is_tm_ntcf)
	shows dg_Funct_Dom_app: "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	and dg_Funct_Cod_app: "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	proof-
	from is_tm_ntcf_axioms show
	"dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	"dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	unfolding dg_Funct_components
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_FUNCT_cs_simps V_cs_simps
	cs_intro: dg_FUNCT_cs_intros cat_cs_intros
	)+
	qed

	lemma (in is_tm_ntcf)
	assumes "\<NN>' = ntcf_arrow \<NN>"
	shows dg_Funct_Dom_app': "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>\<NN>'\<rparr> = cf_map \<FF>"
	and dg_Funct_Cod_app': "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>\<NN>'\<rparr> = cf_map \<GG>"
	unfolding assms by (intro dg_Funct_Dom_app dg_Funct_Cod_app)+

	lemmas [dg_FUNCT_cs_simps] =
	is_tm_ntcf.dg_Funct_Dom_app'
	is_tm_ntcf.dg_Funct_Cod_app'

	lemma
	shows dg_Funct_Dom_vrange: "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	and dg_Funct_Cod_vrange: "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	unfolding dg_Funct_components
	proof(all\<open>intro vrange_VLambda_vsubset\<close>)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	then obtain \<MM> \<FF> \<GG> where \<NN>_def[dg_FUNCT_cs_simps]: "\<NN> = ntcf_arrow \<MM>"
	and \<MM>: "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<MM> show "\<NN>\<lparr>NTDom\<rparr> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	by
	(
	cs_concl
	cs_simp: dg_FUNCT_cs_simps
	cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
	)
	from \<MM> show "\<NN>\<lparr>NTCod\<rparr> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_FUNCT_cs_simps
	cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
	)
	qed


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma dg_Funct_is_arrI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	proof(intro is_arrI, unfold dg_Funct_components(1,2))
	interpret is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms)
	from assms show "ntcf_arrow \<NN> \<in>\<^sub>\<circ> tm_ntcf_arrows \<alpha> \<AA> \<BB>" by auto
	from assms show
	"dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<FF>"
	"dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>\<lparr>ntcf_arrow \<NN>\<rparr> = cf_map \<GG>"
	by (cs_concl cs_shallow cs_simp: dg_FUNCT_cs_simps)+
	qed

	lemma dg_Funct_is_arrI':
	assumes "\<NN>' = ntcf_arrow \<NN>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = cf_map \<FF>"
	and "\<GG>' = cf_map \<GG>"
	shows "\<NN>' : \<FF>' \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>'"
	using assms(2) unfolding assms(1,3,4) by (rule dg_Funct_is_arrI)

	lemmas [dg_FUNCT_cs_intros] = dg_Funct_is_arrI'

	lemma dg_Funct_is_arrD[dest]:
	assumes "\<NN> : \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	proof-
	note \<NN> = is_arrD[OF assms, unfolded dg_Funct_components(2)]
	obtain \<NN>' \<FF>' \<GG>' where \<NN>_def: "\<NN> = ntcf_arrow \<NN>'"
	and \<NN>': "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (elim tm_ntcf_arrowsE[OF \<NN>(1)])
	from \<NN>(2) \<NN>' have \<FF>_def: "\<FF> = cf_map \<FF>'"
	by (cs_prems cs_simp: \<NN>_def dg_FUNCT_cs_simps) simp
	from \<NN>(3) \<NN>' have \<GG>_def: "\<GG> = cf_map \<GG>'"
	by (cs_prems cs_simp: \<NN>_def dg_FUNCT_cs_simps) simp
	from \<NN>' have \<NN>'_def: "\<NN>' = ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>"
	unfolding \<NN>_def
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
	)
	from \<NN>' have \<FF>'_def: "\<FF>' = cf_of_cf_map \<AA> \<BB> \<FF>"
	and \<GG>'_def: "\<GG>' = cf_of_cf_map \<AA> \<BB> \<GG>"
	unfolding \<FF>_def \<GG>_def
	by
	(
	cs_concl
	cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
	)+
	from \<NN>' show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by (fold \<FF>'_def \<GG>'_def \<NN>'_def \<FF>_def \<GG>_def \<NN>_def) simp_all
	qed

	lemma dg_Funct_is_arrE[elim]:
	assumes "\<NN> : \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	obtains \<NN>' \<FF>' \<GG>' where "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow \<NN>'"
	and "\<FF> = cf_map \<FF>'"
	and "\<GG> = cf_map \<GG>'"
	using dg_Funct_is_arrD[OF assms] by auto


	subsubsection\<open>\<open>Funct\<close> is a digraph\<close>

	-lemma (in \<Z>) digraph_dg_Funct:
	+lemma digraph_dg_Funct:
	assumes "tiny_category \<alpha> \<AA>" and "category \<alpha> \<BB>"
	shows "digraph \<alpha> (dg_Funct \<alpha> \<AA> \<BB>)"
	-proof(intro digraphI)
	+proof-

	interpret tiny_category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))

	- show "vfsequence (dg_Funct \<alpha> \<AA> \<BB>)" unfolding dg_Funct_def by simp
	- show "vcard (dg_Funct \<alpha> \<AA> \<BB>) = 4\<^sub>\<nat>"
	- unfolding dg_Funct_def by (simp add: nat_omega_simps)
	- show "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	- by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
	- show "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	- by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
	- show "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	- unfolding dg_Funct_components(1,2) by (rule tm_cf_maps_vsubset_Vset)
	-
	- have RA:
	- "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<in>\<^sub>\<circ> Vset \<alpha>"
	- "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- if "A \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" for A
	- proof-
	- have "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- and "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)))))"
	- proof(all\<open>intro vsubsetI\<close>)
	- fix f assume "f \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))"
	- then obtain \<FF> where \<FF>: "\<FF> \<in>\<^sub>\<circ> A" and f: "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)" by auto
	- with that(1) have "\<FF> \<in>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" by (elim vsubsetE)
	- then obtain \<FF>'
	- where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	- unfolding dg_Funct_components by auto
	- interpret \<FF>': is_tm_functor \<alpha> \<AA> \<BB> \<FF>' by (rule \<FF>')
	- from f obtain a where "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>)" and af: "\<langle>a, f\<rangle> \<in>\<^sub>\<circ> \<FF>'\<lparr>ObjMap\<rparr>"
	- unfolding \<FF>_def cf_map_components vdomain_iff by force
	- then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- using \<FF>'.cf_ObjMap_vrange \<FF>_def cf_map_components(1) f vsubsetE by auto
	- show "f \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)))))"
	- proof(intro VUnionI)
	- show "\<FF> \<in>\<^sub>\<circ> A" by (rule \<FF>)
	- show "set {0, \<FF>\<lparr>ObjMap\<rparr>} \<in>\<^sub>\<circ> \<langle>[]\<^sub>\<circ>, \<FF>\<lparr>ObjMap\<rparr>\<rangle>" unfolding vpair_def by simp
	- show "\<langle>a, f\<rangle> \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	- unfolding \<FF>_def cf_map_components by (intro af)
	- show "set {a, f} \<in>\<^sub>\<circ> \<langle>a, f\<rangle>" unfolding vpair_def by clarsimp
	- qed (clarsimp simp: \<FF>_def cf_map_def dg_FUNCT_Obj_components)+
	- qed
	- moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))))) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (intro VUnion_in_VsetI that(2))
	- ultimately show
	- "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<in>\<^sub>\<circ> Vset \<alpha>"
	- "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- by blast+
	- qed
	-
	- fix A B assume prems:
	- "A \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	- "B \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	- "A \<in>\<^sub>\<circ> Vset \<alpha>"
	- "B \<in>\<^sub>\<circ> Vset \<alpha>"
	-
	- define ARs where "ARs = (\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))"
	- define BRs where "BRs = (\<Union>\<^sub>\<circ>\<GG>\<in>\<^sub>\<circ>B. \<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>))"
	- define Hom_AB where "Hom_AB = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>ARs. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>BRs. Hom \<BB> a b)"
	+ show ?thesis

	- define Q where
	- "Q i = (if i = 0 then VPow (\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB) else if i = 1\<^sub>\<nat> then A else B)"
	- for i
	- have
	- "{[\<NN>, \<FF>, \<GG>]\<^sub>\<circ> \|\<NN> \<FF> \<GG>. \<NN> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> \<FF> \<in>\<^sub>\<circ> A \<and> \<GG> \<in>\<^sub>\<circ> B} \<subseteq>
	- elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	- proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	- fix \<NN>\<FF>\<GG> \<NN> \<FF> \<GG> assume prems':
	- "\<NN>\<FF>\<GG> = [\<NN>, \<FF>, \<GG>]\<^sub>\<circ>" "\<NN> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB" "\<FF> \<in>\<^sub>\<circ> A" "\<GG> \<in>\<^sub>\<circ> B"
	- show "\<NN>\<FF>\<GG> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	- proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	- show "\<D>\<^sub>\<circ> \<NN>\<FF>\<GG> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	- by (simp add: three prems'(1) nat_omega_simps)
	- fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	- then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	- then show "\<NN>\<FF>\<GG>\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
	- by cases (auto simp: Q_def prems' nat_omega_simps)
	- qed (auto simp: prems'(1))
	- qed
	- moreover then have small[simp]:
	- "small {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	- by (rule down)
	- ultimately have
	- "set {[r, a, b]\<^sub>\<circ> \|r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B} \<subseteq>\<^sub>\<circ>
	- (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	- by auto
	- moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule Limit_vproduct_in_VsetI)
	- show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (cs_concl cs_intro: V_cs_intros cat_cs_intros cs_simp: V_cs_simps)
	- have "Hom_AB \<in>\<^sub>\<circ> Vset \<alpha>"
	- unfolding Hom_AB_def
	- by
	- (
	- intro \<BB>.cat_Hom_vifunion_in_Vset prems(3,4),
	- unfold ARs_def BRs_def;
	- intro RA prems
	- )
	- moreover have "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro tiny_cat_Obj_in_Vset)
	- ultimately have "VPow (\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (cs_concl cs_shallow cs_intro: V_cs_intros)
	- with prems(3,4) show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	- unfolding Q_def by (simp_all add: nat_omega_simps)
	- qed auto
	- moreover have
	- "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b) \<subseteq>\<^sub>\<circ>
	- set {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	- proof(rule vsubsetI)
	- fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b)"
	- then obtain \<FF> \<GG>
	- where \<FF>: "\<FF> \<in>\<^sub>\<circ> A"
	- and \<GG>: "\<GG> \<in>\<^sub>\<circ> B"
	- and \<NN>_ab: "\<NN> \<in>\<^sub>\<circ> Hom (dg_Funct \<alpha> \<AA> \<BB>) \<FF> \<GG>"
	+ proof(intro digraphI)
	+
	+ show "vfsequence (dg_Funct \<alpha> \<AA> \<BB>)" unfolding dg_Funct_def by simp
	+ show "vcard (dg_Funct \<alpha> \<AA> \<BB>) = 4\<^sub>\<nat>"
	+ unfolding dg_Funct_def by (simp add: nat_omega_simps)
	+ show "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	+ by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
	+ show "\<R>\<^sub>\<circ> (dg_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	+ by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
	+ show "dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding dg_Funct_components(1,2) by (rule tm_cf_maps_vsubset_Vset)
	+
	+ have RA:
	+ "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ if "A \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" for A
	+ proof-
	+ have "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ and "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)))))"
	+ proof(all\<open>intro vsubsetI\<close>)
	+ fix f assume "f \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))"
	+ then obtain \<FF> where \<FF>: "\<FF> \<in>\<^sub>\<circ> A" and f: "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)" by auto
	+ with that(1) have "\<FF> \<in>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" by (elim vsubsetE)
	+ then obtain \<FF>'
	+ where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ unfolding dg_Funct_components by auto
	+ interpret \<FF>': is_tm_functor \<alpha> \<AA> \<BB> \<FF>' by (rule \<FF>')
	+ from f obtain a where "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>)" and af: "\<langle>a, f\<rangle> \<in>\<^sub>\<circ> \<FF>'\<lparr>ObjMap\<rparr>"
	+ unfolding \<FF>_def cf_map_components vdomain_iff by force
	+ then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ using \<FF>'.cf_ObjMap_vrange \<FF>_def cf_map_components(1) f vsubsetE by auto
	+ show "f \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)))))"
	+ proof(intro VUnionI)
	+ show "\<FF> \<in>\<^sub>\<circ> A" by (rule \<FF>)
	+ show "set {0, \<FF>\<lparr>ObjMap\<rparr>} \<in>\<^sub>\<circ> \<langle>[]\<^sub>\<circ>, \<FF>\<lparr>ObjMap\<rparr>\<rangle>" unfolding vpair_def by simp
	+ show "\<langle>a, f\<rangle> \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	+ unfolding \<FF>_def cf_map_components by (intro af)
	+ show "set {a, f} \<in>\<^sub>\<circ> \<langle>a, f\<rangle>" unfolding vpair_def by clarsimp
	+ qed (clarsimp simp: \<FF>_def cf_map_def dg_FUNCT_Obj_components)+
	+ qed
	+ moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro VUnion_in_VsetI that(2))
	+ ultimately show
	+ "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ "(\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ by blast+
	+ qed
	+
	+ fix A B assume prems:
	+ "A \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	+ "B \<subseteq>\<^sub>\<circ> dg_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	+ "A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ "B \<in>\<^sub>\<circ> Vset \<alpha>"
	+
	+ define ARs where "ARs = (\<Union>\<^sub>\<circ>\<FF>\<in>\<^sub>\<circ>A. \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))"
	+ define BRs where "BRs = (\<Union>\<^sub>\<circ>\<GG>\<in>\<^sub>\<circ>B. \<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>))"
	+ define Hom_AB where "Hom_AB = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>ARs. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>BRs. Hom \<BB> a b)"
	+
	+ define Q where
	+ "Q i = (if i = 0 then VPow (\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB) else if i = 1\<^sub>\<nat> then A else B)"
	+ for i
	+ have
	+ "{[\<NN>, \<FF>, \<GG>]\<^sub>\<circ> \|\<NN> \<FF> \<GG>. \<NN> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> \<FF> \<in>\<^sub>\<circ> A \<and> \<GG> \<in>\<^sub>\<circ> B} \<subseteq>
	+ elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	+ fix \<NN>\<FF>\<GG> \<NN> \<FF> \<GG> assume prems':
	+ "\<NN>\<FF>\<GG> = [\<NN>, \<FF>, \<GG>]\<^sub>\<circ>" "\<NN> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB" "\<FF> \<in>\<^sub>\<circ> A" "\<GG> \<in>\<^sub>\<circ> B"
	+ show "\<NN>\<FF>\<GG> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	+ fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	+ then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	+ then show "\<NN>\<FF>\<GG>\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
	+ by cases (auto simp: Q_def prems' nat_omega_simps)
	+ qed (auto simp: prems'(1) three nat_omega_simps)
	+ qed
	+ moreover then have small[simp]:
	+ "small {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	+ by (rule down)
	+ ultimately have
	+ "set {[r, a, b]\<^sub>\<circ> \|r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B} \<subseteq>\<^sub>\<circ>
	+ (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	by auto
	- then have "\<NN> : \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>" by simp
	- note \<NN> = dg_Funct_is_arrD[OF this]
	- show
	- "\<NN> \<in>\<^sub>\<circ> set {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	- proof(intro in_set_CollectI small exI conjI)
	- show "\<NN> =
	- [
	- ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>,
	- cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr>),
	- cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr>)
	- ]\<^sub>\<circ>"
	- by (rule \<NN>(2)[unfolded ntcf_arrow_def])
	- interpret \<NN>: is_tm_ntcf \<alpha>
	- \<AA> \<BB>
	- \<open>cf_of_cf_map \<AA> \<BB> \<FF>\<close> \<open>cf_of_cf_map \<AA> \<BB> \<GG>\<close>
	- \<open>ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<close>
	- rewrites "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	- and "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	- and "cf_of_cf_map \<AA> \<BB> \<GG>\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr>"
	- by
	+ moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule Limit_vproduct_in_VsetI)
	+ show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (cs_concl cs_intro: V_cs_intros cat_cs_intros cs_simp: V_cs_simps)
	+ have "Hom_AB \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding Hom_AB_def
	+ by
	(
	- rule \<NN>(1),
	- unfold ntcf_of_ntcf_arrow_components cf_of_cf_map_components
	- )
	- simp_all
	- show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB"
	- proof(intro vsubsetI, unfold ntcf_of_ntcf_arrow_components)
	- fix af assume prems'': "af \<in>\<^sub>\<circ> \<NN>\<lparr>NTMap\<rparr>"
	- then obtain a f where af_def: "af = \<langle>a, f\<rangle>"
	- and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	- and f: "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	- by (elim \<NN>.NTMap.vbrelation_vinE)
	- from prems'' have f_def: "f = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- unfolding af_def \<NN>.NTMap.vsv_ex1_app1[OF a] .
	- have \<NN>a: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- by (rule \<NN>.ntcf_NTMap_is_arr[OF a])
	- have "f \<in>\<^sub>\<circ> Hom_AB"
	- unfolding f_def Hom_AB_def ARs_def BRs_def
	- proof(intro vifunionI, unfold in_Hom_iff)
	- show "\<FF> \<in>\<^sub>\<circ> A" by (intro \<FF>)
	- from a show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	- by (metis \<NN>.NTDom.ObjMap.vdomain_atD \<NN>.NTDom.cf_ObjMap_vdomain)
	- show "\<GG> \<in>\<^sub>\<circ> B" by (intro \<GG>)
	- from a show "\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>)"
	- by (metis \<NN>.NTCod.ObjMap.vdomain_atD \<NN>.NTCod.cf_ObjMap_vdomain)
	- show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" by (intro \<NN>a)
	+ intro \<BB>.cat_Hom_vifunion_in_Vset prems(3,4),
	+ unfold ARs_def BRs_def;
	+ intro RA prems
	+ )
	+ moreover have "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro tiny_cat_Obj_in_Vset)
	+ ultimately have "VPow (\<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (cs_concl cs_shallow cs_intro: V_cs_intros)
	+ with prems(3,4) show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	+ unfolding Q_def by (simp_all add: nat_omega_simps)
	+ qed auto
	+ moreover have
	+ "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b) \<subseteq>\<^sub>\<circ>
	+ set {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	+ proof(rule vsubsetI)
	+ fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b)"
	+ then obtain \<FF> \<GG>
	+ where \<FF>: "\<FF> \<in>\<^sub>\<circ> A"
	+ and \<GG>: "\<GG> \<in>\<^sub>\<circ> B"
	+ and \<NN>_ab: "\<NN> \<in>\<^sub>\<circ> Hom (dg_Funct \<alpha> \<AA> \<BB>) \<FF> \<GG>"
	+ by auto
	+ then have "\<NN> : \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>" by simp
	+ note \<NN> = dg_Funct_is_arrD[OF this]
	+ show
	+ "\<NN> \<in>\<^sub>\<circ> set {[r, a, b]\<^sub>\<circ> \| r a b. r \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB \<and> a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> B}"
	+ proof(intro in_set_CollectI small exI conjI)
	+ show "\<NN> =
	+ [
	+ ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>,
	+ cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr>),
	+ cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr>)
	+ ]\<^sub>\<circ>"
	+ by (rule \<NN>(2)[unfolded ntcf_arrow_def])
	+ interpret \<NN>: is_tm_ntcf \<alpha>
	+ \<AA> \<BB>
	+ \<open>cf_of_cf_map \<AA> \<BB> \<FF>\<close> \<open>cf_of_cf_map \<AA> \<BB> \<GG>\<close>
	+ \<open>ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<close>
	+ rewrites "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	+ and "cf_of_cf_map \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	+ and "cf_of_cf_map \<AA> \<BB> \<GG>\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr>"
	+ by
	+ (
	+ rule \<NN>(1),
	+ unfold ntcf_of_ntcf_arrow_components cf_of_cf_map_components
	+ )
	+ simp_all
	+ show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB"
	+ proof(intro vsubsetI, unfold ntcf_of_ntcf_arrow_components)
	+ fix af assume prems'': "af \<in>\<^sub>\<circ> \<NN>\<lparr>NTMap\<rparr>"
	+ then obtain a f where af_def: "af = \<langle>a, f\<rangle>"
	+ and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and f: "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	+ by (elim \<NN>.NTMap.vbrelation_vinE)
	+ from prems'' have f_def: "f = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ unfolding af_def \<NN>.NTMap.vsv_ex1_app1[OF a] .
	+ have \<NN>a: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by (rule \<NN>.ntcf_NTMap_is_arr[OF a])
	+ have "f \<in>\<^sub>\<circ> Hom_AB"
	+ unfolding f_def Hom_AB_def ARs_def BRs_def
	+ proof(intro vifunionI, unfold in_Hom_iff)
	+ show "\<FF> \<in>\<^sub>\<circ> A" by (intro \<FF>)
	+ from a show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ by (metis \<NN>.NTDom.ObjMap.vdomain_atD \<NN>.NTDom.cf_ObjMap_vdomain)
	+ show "\<GG> \<in>\<^sub>\<circ> B" by (intro \<GG>)
	+ from a show "\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>)"
	+ by (metis \<NN>.NTCod.ObjMap.vdomain_atD \<NN>.NTCod.cf_ObjMap_vdomain)
	+ show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" by (intro \<NN>a)
	+ qed
	+ with a show "af \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB" unfolding af_def f_def by simp
	qed
	- with a show "af \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<times>\<^sub>\<circ> Hom_AB" unfolding af_def f_def by simp
	+ show "cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr>) \<in>\<^sub>\<circ> A"
	+ unfolding \<NN>.ntcf_NTDom \<NN>(3)[symmetric] by (rule \<FF>)
	+ show "cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr>) \<in>\<^sub>\<circ> B"
	+ unfolding \<NN>.ntcf_NTCod \<NN>(4)[symmetric] by (rule \<GG>)
	qed
	- show "cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr>) \<in>\<^sub>\<circ> A"
	- unfolding \<NN>.ntcf_NTDom \<NN>(3)[symmetric] by (rule \<FF>)
	- show "cf_map (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr>) \<in>\<^sub>\<circ> B"
	- unfolding \<NN>.ntcf_NTCod \<NN>(4)[symmetric] by (rule \<GG>)
	qed
	- qed
	- ultimately show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by blast
	-qed (unfold dg_Funct_components, auto)
	+ ultimately show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (dg_Funct \<alpha> \<AA> \<BB>) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by blast
	+ qed (auto simp: dg_Funct_components)
	+
	+qed


	subsubsection\<open>\<open>Funct\<close> is a subdigraph of \<open>FUNCT\<close>\<close>

	-lemma (in \<Z>) subdigraph_dg_Funct_dg_FUNCT:
	+lemma subdigraph_dg_Funct_dg_FUNCT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "tiny_category \<alpha> \<AA>" and "category \<alpha> \<BB>"
	shows "dg_Funct \<alpha> \<AA> \<BB> \<subseteq>\<^sub>D\<^sub>G\<^bsub>\<beta>\<^esub> dg_FUNCT \<alpha> \<AA> \<BB>"
	proof(intro subdigraphI, unfold dg_FUNCT_components(1) dg_Funct_components(1))
	+ interpret \<AA>: tiny_category \<alpha> \<AA> by (rule assms(3))
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "digraph \<beta> (dg_Funct \<alpha> \<AA> \<BB>)"
	by (intro digraph.dg_digraph_if_ge_Limit[OF digraph_dg_Funct] assms)
	from assms show "digraph \<beta> (dg_FUNCT \<alpha> \<AA> \<BB>)"
	- by (cs_concl cs_shallow cs_intro: dg_small_cs_intros tiny_digraph_dg_FUNCT)
	+ by (cs_concl cs_shallow cs_intro: dg_small_cs_intros \<AA>.tiny_digraph_dg_FUNCT)
	show "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>" if "\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>" for \<FF>
	using that
	by (cs_concl cs_shallow cs_intro: dg_FUNCT_cs_intros tm_cf_maps_in_cf_maps)
	show "\<NN> : \<FF> \<mapsto>\<^bsub>dg_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>" if "\<NN> : \<FF> \<mapsto>\<^bsub>dg_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	for \<NN> \<FF> \<GG>
	proof-
	note f = dg_Funct_is_arrD[OF that]
	from f(1) show ?thesis
	by (subst f(2), use nothing in \<open>subst f(3), subst f(4)\<close>)
	(cs_concl cs_shallow cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros)
	qed
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_CAT.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_CAT.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_CAT.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_CAT.thy
	@@ -1,290 +1,286 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>CAT\<close>\<close>
	theory CZH_ECAT_CAT
	imports CZH_SMC_CAT
	begin



	subsection\<open>Background\<close>


	text\<open>
	The subsection presents the theory of the categories of \<open>\<alpha>\<close>-categories.
	It continues the development that was initiated in sections
	\ref{sec:dg_CAT}-\ref{sec:smc_CAT}.
	\<close>

	named_theorems cat_CAT_simps
	named_theorems cat_CAT_intros



	subsection\<open>Definition and elementary properties\<close>

	definition cat_CAT :: "V \<Rightarrow> V"
	where "cat_CAT \<alpha> =
	[
	set {\<CC>. category \<alpha> \<CC>},
	all_cfs \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>),
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_CAT \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>C\<^sub>F \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. category \<alpha> \<CC>}. cf_id \<CC>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_CAT_components:
	shows "cat_CAT \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. category \<alpha> \<CC>}"
	and "cat_CAT \<alpha>\<lparr>Arr\<rparr> = all_cfs \<alpha>"
	and "cat_CAT \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "cat_CAT \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_cfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	and "cat_CAT \<alpha>\<lparr>Comp\<rparr> =
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_CAT \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>C\<^sub>F \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_CAT \<alpha>\<lparr>CId\<rparr> = (\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. category \<alpha> \<CC>}. cf_id \<CC>)"
	unfolding cat_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_CAT: "cat_smc (cat_CAT \<alpha>) = smc_CAT \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_CAT \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_CAT \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_CAT_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_CAT \<alpha>)) = \<D>\<^sub>\<circ> (smc_CAT \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_CAT \<alpha>)) \<Longrightarrow> cat_smc (cat_CAT \<alpha>)\<lparr>a\<rparr> = smc_CAT \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_CAT_def smc_CAT_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: cat_smc_def smc_CAT_def)

	lemmas_with [folded cat_smc_CAT, unfolded slicing_simps]:
	\<comment>\<open>Digraph\<close>
	cat_CAT_ObjI = smc_CAT_ObjI
	and cat_CAT_ObjD = smc_CAT_ObjD
	and cat_CAT_ObjE = smc_CAT_ObjE
	and cat_CAT_Obj_iff[cat_CAT_simps] = smc_CAT_Obj_iff
	and cat_CAT_Dom_app[cat_CAT_simps] = smc_CAT_Dom_app
	and cat_CAT_Cod_app[cat_CAT_simps] = smc_CAT_Cod_app
	and cat_CAT_is_arrI = smc_CAT_is_arrI
	and cat_CAT_is_arrD = smc_CAT_is_arrD
	and cat_CAT_is_arrE = smc_CAT_is_arrE
	and cat_CAT_is_arr_iff[cat_CAT_simps] = smc_CAT_is_arr_iff

	lemmas_with [folded cat_smc_CAT, unfolded slicing_simps, unfolded cat_smc_CAT]:
	\<comment>\<open>Semicategory\<close>
	cat_CAT_Comp_vdomain = smc_CAT_Comp_vdomain
	and cat_CAT_composable_arrs_dg_CAT = smc_CAT_composable_arrs_dg_CAT
	and cat_CAT_Comp = smc_CAT_Comp
	and cat_CAT_Comp_app[cat_CAT_simps] = smc_CAT_Comp_app
	and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange

	lemmas_with (in \<Z>) [folded cat_smc_CAT, unfolded slicing_simps]:
	\<comment>\<open>Semicategory\<close>
	cat_CAT_obj_initialI = smc_CAT_obj_initialI
	and cat_CAT_obj_initialD = smc_CAT_obj_initialD
	and cat_CAT_obj_initialE = smc_CAT_obj_initialE
	and cat_CAT_obj_initial_iff[cat_CAT_simps] = smc_CAT_obj_initial_iff
	and cat_CAT_obj_terminalI = smc_CAT_obj_terminalI
	and cat_CAT_obj_terminalE = smc_CAT_obj_terminalE



	subsection\<open>Identity\<close>

	lemma cat_CAT_CId_app[cat_CAT_simps]:
	assumes "category \<alpha> \<CC>"
	shows "cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<CC>\<rparr> = cf_id \<CC>"
	using assms unfolding cat_CAT_components by simp

	lemma cat_CAT_CId_vdomain: "\<D>\<^sub>\<circ> (cat_CAT \<alpha>\<lparr>CId\<rparr>) = set {\<CC>. category \<alpha> \<CC>}"
	unfolding cat_CAT_components by auto

	lemma cat_CAT_CId_vrange: "\<R>\<^sub>\<circ> (cat_CAT \<alpha>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> all_cfs \<alpha>"
	proof(rule vsubsetI)
	fix \<HH> assume "\<HH> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (cat_CAT \<alpha>\<lparr>CId\<rparr>)"
	then obtain \<AA>
	where \<HH>_def: "\<HH> = cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>"
	and \<AA>: "\<AA> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_CAT \<alpha>\<lparr>CId\<rparr>)"
	unfolding cat_CAT_components by auto
	from \<AA> have \<HH>_def': "\<HH> = cf_id \<AA>"
	unfolding \<HH>_def cat_CAT_CId_vdomain by (auto simp: cat_CAT_CId_app)
	from \<AA> category.cat_cf_id_is_functor show "\<HH> \<in>\<^sub>\<circ> all_cfs \<alpha>"
	unfolding \<HH>_def' cat_CAT_CId_vdomain by force
	qed



	subsection\<open>\<open>CAT\<close> is a category\<close>

	lemma (in \<Z>) tiny_category_cat_CAT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_category \<beta> (cat_CAT \<alpha>)"
	proof(intro tiny_categoryI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "vfsequence (cat_CAT \<alpha>)" unfolding cat_CAT_def by simp
	show "vcard (cat_CAT \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_CAT_def by (simp add: nat_omega_simps)
	show "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB> \<Longrightarrow> cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> \<FF> = \<FF>"
	for \<FF> \<AA> \<BB>
	proof-
	assume prems: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	then have b: "category \<alpha> \<BB>" unfolding cat_CAT_is_arr_iff by auto
	with digraph.dg_dghm_id_is_dghm have
	"cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> : \<BB> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	by
	(
	simp add:
	cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
	)
	with prems b show "cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> \<FF> = \<FF>"
	by
	(
	simp add:
	cat_CAT_CId_app
	cat_CAT_Comp_app
	cat_CAT_is_arr_iff
	is_functor.cf_cf_comp_cf_id_left
	)
	qed
	show "\<FF> : \<BB> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<CC> \<Longrightarrow> \<FF> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> = \<FF>"
	for \<FF> \<BB> \<CC>
	proof-
	assume prems: "\<FF> : \<BB> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<CC>"
	then have b: "category \<alpha> \<BB>" unfolding cat_CAT_is_arr_iff by auto
	then have "cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> : \<BB> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	by
	(
	simp add:
	cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
	)
	with prems b show "\<FF> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> = \<FF>"
	by
	(
	auto
	simp: cat_CAT_CId_app cat_CAT_Comp_app cat_CAT_is_arr_iff
	intro: is_functor.cf_cf_comp_cf_id_right
	)
	qed
	qed
	(
	simp_all add:
	assms
	cat_smc_CAT
	cat_CAT_components
	\<Z>.intro
	\<Z>_Limit_\<alpha>\<omega>
	\<Z>_\<omega>_\<alpha>\<omega>
	cat_CAT_is_arr_iff
	tiny_semicategory_smc_CAT
	category.cat_cf_id_is_functor
	)

	lemmas [cat_cs_intros] = \<Z>.tiny_category_cat_CAT



	subsection\<open>Isomorphism\<close>

	-lemma (in \<Z>) cat_CAT_is_arr_isomorphismI:
	+lemma cat_CAT_is_iso_arrI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	from assms show \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	unfolding cat_CAT_is_arr_iff by auto
	- note iso_thms = is_iso_functor_is_arr_isomorphism[OF assms]
	+ note iso_thms = is_iso_functor_is_iso_arr[OF assms]
	from iso_thms(1) show inv_\<FF>: "inv_cf \<FF> : \<BB> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<AA>"
	unfolding cat_CAT_is_arr_iff by auto
	from assms show "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	unfolding cat_CAT_is_arr_iff by auto
	from assms have \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" by auto
	show "inv_cf \<FF> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> \<FF> = cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>"
	unfolding cat_CAT_CId_app[OF \<AA>] cat_CAT_Comp_app[OF inv_\<FF> \<FF>]
	by (rule iso_thms(2))
	show "\<FF> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> inv_cf \<FF> = cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr>"
	unfolding cat_CAT_CId_app[OF \<BB>] cat_CAT_Comp_app[OF \<FF> inv_\<FF>]
	by (rule iso_thms(3))
	qed

	-lemma (in \<Z>) cat_CAT_is_arr_isomorphismD:
	+lemma cat_CAT_is_iso_arrD:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	- from is_arr_isomorphismD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	+ from is_iso_arrD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	and "(\<exists>\<GG>. is_inverse (cat_CAT \<alpha>) \<GG> \<FF>)"
	by simp_all
	then obtain \<GG> where "is_inverse (cat_CAT \<alpha>) \<GG> \<FF>" by clarsimp
	then obtain \<AA>' \<BB>' where \<GG>': "\<GG> : \<BB>' \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<AA>'"
	and \<FF>': "\<FF> : \<AA>' \<mapsto>\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>'"
	and \<GG>\<FF>: "\<GG> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> \<FF> = cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>'\<rparr>"
	and \<FF>\<GG>: "\<FF> \<circ>\<^sub>A\<^bsub>cat_CAT \<alpha>\<^esub> \<GG> = cat_CAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>'\<rparr>"
	by auto
	from \<FF> \<FF>' have \<AA>': "\<AA>' = \<AA>" and \<BB>': "\<BB>' = \<BB>" by auto
	from \<FF> have \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" unfolding cat_CAT_is_arr_iff by simp
	then have \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" by auto
	- from \<GG>' have "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	- unfolding \<AA>' \<BB>' cat_CAT_is_arr_iff by simp
	+ from \<GG>' have "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" unfolding \<AA>' \<BB>' cat_CAT_is_arr_iff by simp
	moreover from \<GG>\<FF> have "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
	- unfolding \<AA>' cat_CAT_Comp_app[OF \<GG>' \<FF>'] cat_CAT_CId_app[OF \<AA>]
	- by simp
	+ unfolding \<AA>' cat_CAT_Comp_app[OF \<GG>' \<FF>'] cat_CAT_CId_app[OF \<AA>] by simp
	moreover from \<FF>\<GG> have "\<FF> \<circ>\<^sub>C\<^sub>F \<GG> = cf_id \<BB>"
	- unfolding \<BB>' cat_CAT_Comp_app[OF \<FF>' \<GG>'] cat_CAT_CId_app[OF \<BB>]
	- by simp
	- ultimately show ?thesis
	- using \<FF> by (elim is_arr_isomorphism_is_iso_functor)
	+ unfolding \<BB>' cat_CAT_Comp_app[OF \<FF>' \<GG>'] cat_CAT_CId_app[OF \<BB>] by simp
	+ ultimately show ?thesis using \<FF> by (elim is_iso_arr_is_iso_functor)
	qed

	-lemma (in \<Z>) cat_CAT_is_arr_isomorphismE:
	+lemma cat_CAT_is_iso_arrE:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using assms by (auto dest: cat_CAT_is_arr_isomorphismD)
	+ using assms by (auto dest: cat_CAT_is_iso_arrD)

	-lemma (in \<Z>) cat_CAT_is_arr_isomorphism_iff[cat_CAT_simps]:
	+lemma cat_CAT_is_iso_arr_iff[cat_CAT_simps]:
	"\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_CAT \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using cat_CAT_is_arr_isomorphismI cat_CAT_is_arr_isomorphismD by auto
	+ using cat_CAT_is_iso_arrI cat_CAT_is_iso_arrD by auto



	subsection\<open>Isomorphic objects\<close>

	-lemma (in \<Z>) cat_CAT_obj_isoI:
	+lemma cat_CAT_obj_isoI:
	assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	proof-
	from iso_categoryD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_CAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
	+ from cat_CAT_is_iso_arrI[OF this] show ?thesis by (rule obj_isoI)
	qed

	-lemma (in \<Z>) cat_CAT_obj_isoD:
	+lemma cat_CAT_obj_isoD:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	from obj_isoD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_CAT_is_arr_isomorphismD[OF this] show ?thesis by (rule iso_categoryI)
	+ from cat_CAT_is_iso_arrD[OF this] show ?thesis by (rule iso_categoryI)
	qed

	-lemma (in \<Z>) cat_CAT_obj_isoE:
	+lemma cat_CAT_obj_isoE:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_CAT \<alpha>\<^esub> \<BB>"
	obtains "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (auto simp: cat_CAT_obj_isoD)

	-lemma (in \<Z>) cat_CAT_obj_iso_iff[cat_CAT_simps]:
	+lemma cat_CAT_obj_iso_iff[cat_CAT_simps]:
	"\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_CAT \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using cat_CAT_obj_isoI cat_CAT_obj_isoD by (intro iffI) auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Category.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Category.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Category.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Category.thy
	@@ -1,1532 +1,1532 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Category\<close>
	theory CZH_ECAT_Category
	imports
	CZH_ECAT_Introduction
	CZH_Foundations.CZH_SMC_Semicategory
	begin



	subsection\<open>Background\<close>

	lemmas [cat_cs_simps] = dg_shared_cs_simps
	lemmas [cat_cs_intros] = dg_shared_cs_intros

	definition CId :: V
	where [dg_field_simps]: "CId = 5\<^sub>\<nat>"



	subsubsection\<open>Slicing\<close>

	definition cat_smc :: "V \<Rightarrow> V"
	where "cat_smc \<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_smc_components[slicing_simps]:
	shows "cat_smc \<CC>\<lparr>Obj\<rparr> = \<CC>\<lparr>Obj\<rparr>"
	and "cat_smc \<CC>\<lparr>Arr\<rparr> = \<CC>\<lparr>Arr\<rparr>"
	and "cat_smc \<CC>\<lparr>Dom\<rparr> = \<CC>\<lparr>Dom\<rparr>"
	and "cat_smc \<CC>\<lparr>Cod\<rparr> = \<CC>\<lparr>Cod\<rparr>"
	and "cat_smc \<CC>\<lparr>Comp\<rparr> = \<CC>\<lparr>Comp\<rparr>"
	unfolding cat_smc_def dg_field_simps by (auto simp: nat_omega_simps)


	text\<open>Regular definitions.\<close>

	lemma cat_smc_is_arr[slicing_simps]:
	"f : a \<mapsto>\<^bsub>cat_smc \<CC>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding is_arr_def slicing_simps ..

	lemmas [slicing_intros] = cat_smc_is_arr[THEN iffD2]

	lemma cat_smc_composable_arrs[slicing_simps]:
	"composable_arrs (cat_smc \<CC>) = composable_arrs \<CC>"
	unfolding composable_arrs_def slicing_simps ..

	lemma cat_smc_is_monic_arr[slicing_simps]:
	"f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_smc \<CC>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b"
	unfolding is_monic_arr_def slicing_simps ..

	lemmas [slicing_intros] = cat_smc_is_monic_arr[THEN iffD2]

	lemma cat_smc_is_epic_arr[slicing_simps]:
	"f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>cat_smc \<CC>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	unfolding is_epic_arr_def slicing_simps op_smc_def
	by (simp add: nat_omega_simps)

	lemmas [slicing_intros] = cat_smc_is_epic_arr[THEN iffD2]

	lemma cat_smc_is_idem_arr[slicing_simps]:
	"f : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<^bsub>cat_smc \<CC>\<^esub> b \<longleftrightarrow> f : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<CC>\<^esub> b"
	unfolding is_idem_arr_def slicing_simps ..

	lemmas [slicing_intros] = cat_smc_is_idem_arr[THEN iffD2]

	lemma cat_smc_obj_terminal[slicing_simps]:
	"obj_terminal (cat_smc \<CC>) a \<longleftrightarrow> obj_terminal \<CC> a"
	unfolding obj_terminal_def slicing_simps ..

	lemmas [slicing_intros] = cat_smc_obj_terminal[THEN iffD2]

	lemma cat_smc_obj_intial[slicing_simps]:
	"obj_initial (cat_smc \<CC>) a \<longleftrightarrow> obj_initial \<CC> a"
	unfolding obj_initial_def obj_terminal_def
	unfolding smc_op_simps slicing_simps
	..

	lemmas [slicing_intros] = cat_smc_obj_intial[THEN iffD2]

	lemma cat_smc_obj_null[slicing_simps]:
	"obj_null (cat_smc \<CC>) a \<longleftrightarrow> obj_null \<CC> a"
	unfolding obj_null_def slicing_simps smc_op_simps ..

	lemmas [slicing_intros] = cat_smc_obj_null[THEN iffD2]

	lemma cat_smc_is_zero_arr[slicing_simps]:
	"f : a \<mapsto>\<^sub>0\<^bsub>cat_smc \<CC>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	unfolding is_zero_arr_def slicing_simps ..

	lemmas [slicing_intros] = cat_smc_is_zero_arr[THEN iffD2]



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	The definition of a category that is used in this work is
	is similar to the definition that can be found in Chapter I-2 in
	\cite{mac_lane_categories_2010}. The amendments to the definitions that are
	associated with size have already been explained in
	\cite{milehins_category_2021}.
	\<close>

	locale category = \<Z> \<alpha> + vfsequence \<CC> + CId: vsv \<open>\<CC>\<lparr>CId\<rparr>\<close> for \<alpha> \<CC> +
	assumes cat_length[cat_cs_simps]: "vcard \<CC> = 6\<^sub>\<nat>"
	and cat_semicategory[slicing_intros]: "semicategory \<alpha> (cat_smc \<CC>)"
	and cat_CId_vdomain[cat_cs_simps]: "\<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	and cat_CId_is_arr[cat_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and cat_CId_left_left[cat_cs_simps]:
	"f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
	and cat_CId_right_left[cat_cs_simps]:
	"f : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"

	lemmas [cat_cs_simps] =
	category.cat_length
	category.cat_CId_vdomain
	category.cat_CId_left_left
	category.cat_CId_right_left

	lemma (in category) cat_CId_is_arr'[cat_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b = a" and "c = a" and "\<CC>' = \<CC>"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : b \<mapsto>\<^bsub>\<CC>'\<^esub> c"
	using assms(1) unfolding assms(2-4) by (rule cat_CId_is_arr)

	lemmas [cat_cs_intros] = category.cat_CId_is_arr'

	lemma (in category) cat_CId_is_arr''[cat_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	shows "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	using assms(1)
	unfolding assms(2)
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	lemmas [cat_cs_intros] = category.cat_CId_is_arr''

	lemmas [slicing_intros] = category.cat_semicategory

	lemma (in category) cat_CId_vrange: "\<R>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof
	fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>)"
	with cat_CId_vdomain obtain a where "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by (auto elim!: CId.vrange_atE)
	with cat_CId_is_arr show "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by auto
	qed


	text\<open>Rules.\<close>

	lemma (in category) category_axioms'[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "category \<alpha>' \<CC>"
	unfolding assms by (rule category_axioms)

	mk_ide rf category_def[unfolded category_axioms_def]
	\|intro categoryI\|
	\|dest categoryD[dest]\|
	\|elim categoryE[elim]\|

	lemma categoryI':
	assumes "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vcard \<CC> = 6\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vsv (\<CC>\<lparr>CId\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<And>a. a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
	and "\<And>b c f. f : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "category \<alpha> \<CC>"
	by (intro categoryI semicategoryI', unfold cat_smc_components slicing_simps)
	(simp_all add: assms smc_dg_def nat_omega_simps cat_smc_def)

	lemma categoryD':
	assumes "category \<alpha> \<CC>"
	shows "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vcard \<CC> = 6\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vsv (\<CC>\<lparr>CId\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<And>a. a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
	and "\<And>b c f. f : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	simp_all add:
	categoryD(2-9)[OF assms]
	semicategoryD'[OF categoryD(5)[OF assms], unfolded slicing_simps]
	)

	lemma categoryE':
	assumes "category \<alpha> \<CC>"
	obtains "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vcard \<CC> = 6\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vsv (\<CC>\<lparr>CId\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<And>a. a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
	and "\<And>b c f. f : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp add: categoryD')


	text\<open>Slicing.\<close>

	context category
	begin

	interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)

	sublocale Dom: vsv \<open>\<CC>\<lparr>Dom\<rparr>\<close>
	by (rule smc.Dom.vsv_axioms[unfolded slicing_simps])
	sublocale Cod: vsv \<open>\<CC>\<lparr>Cod\<rparr>\<close>
	by (rule smc.Cod.vsv_axioms[unfolded slicing_simps])
	sublocale Comp: pbinop \<open>\<CC>\<lparr>Arr\<rparr>\<close> \<open>\<CC>\<lparr>Comp\<rparr>\<close>
	by (rule smc.Comp.pbinop_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	cat_Dom_vdomain[cat_cs_simps] = smc.smc_Dom_vdomain
	and cat_Dom_vrange = smc.smc_Dom_vrange
	and cat_Cod_vdomain[cat_cs_simps] = smc.smc_Cod_vdomain
	and cat_Cod_vrange = smc.smc_Cod_vrange
	and cat_Obj_vsubset_Vset = smc.smc_Obj_vsubset_Vset
	and cat_Hom_vifunion_in_Vset[cat_cs_intros] = smc.smc_Hom_vifunion_in_Vset
	and cat_Obj_if_Dom_vrange = smc.smc_Obj_if_Dom_vrange
	and cat_Obj_if_Cod_vrange = smc.smc_Obj_if_Cod_vrange
	and cat_is_arrD = smc.smc_is_arrD
	and cat_is_arrE[elim] = smc.smc_is_arrE
	and cat_in_ArrE[elim] = smc.smc_in_ArrE
	and cat_Hom_in_Vset[cat_cs_intros] = smc.smc_Hom_in_Vset
	and cat_Arr_vsubset_Vset = smc.smc_Arr_vsubset_Vset
	and cat_Dom_vsubset_Vset = smc.smc_Dom_vsubset_Vset
	and cat_Cod_vsubset_Vset = smc.smc_Cod_vsubset_Vset
	and cat_Obj_in_Vset = smc.smc_Obj_in_Vset
	and cat_in_Obj_in_Vset[cat_cs_intros] = smc.smc_in_Obj_in_Vset
	and cat_Arr_in_Vset = smc.smc_Arr_in_Vset
	and cat_in_Arr_in_Vset[cat_cs_intros] = smc.smc_in_Arr_in_Vset
	and cat_Dom_in_Vset = smc.smc_Dom_in_Vset
	and cat_Cod_in_Vset = smc.smc_Cod_in_Vset
	and cat_semicategory_if_ge_Limit = smc.smc_semicategory_if_ge_Limit
	and cat_Dom_app_in_Obj = smc.smc_Dom_app_in_Obj
	and cat_Cod_app_in_Obj = smc.smc_Cod_app_in_Obj
	and cat_Arr_vempty_if_Obj_vempty = smc.smc_Arr_vempty_if_Obj_vempty
	and cat_Dom_vempty_if_Arr_vempty = smc.smc_Dom_vempty_if_Arr_vempty
	and cat_Cod_vempty_if_Arr_vempty = smc.smc_Cod_vempty_if_Arr_vempty

	lemmas [cat_cs_intros] = cat_is_arrD(2,3)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	cat_Comp_vdomain = smc.smc_Comp_vdomain
	and cat_Comp_is_arr[cat_cs_intros] = smc.smc_Comp_is_arr
	and cat_Comp_assoc[cat_cs_intros] = smc.smc_Comp_assoc
	and cat_Comp_vdomainI[cat_cs_intros] = smc.smc_Comp_vdomainI
	and cat_Comp_vdomainE[elim!] = smc.smc_Comp_vdomainE
	and cat_Comp_vdomain_is_composable_arrs =
	smc.smc_Comp_vdomain_is_composable_arrs
	and cat_Comp_vrange = smc.smc_Comp_vrange
	and cat_Comp_vsubset_Vset = smc.smc_Comp_vsubset_Vset
	and cat_Comp_in_Vset = smc.smc_Comp_in_Vset
	and cat_Comp_vempty_if_Arr_vempty = smc.smc_Comp_vempty_if_Arr_vempty
	and cat_assoc_helper = smc.smc_assoc_helper
	and cat_pattern_rectangle_right = smc.smc_pattern_rectangle_right
	and cat_pattern_rectangle_left = smc.smc_pattern_rectangle_left
	and is_epic_arrI = smc.is_epic_arrI
	and is_epic_arrD[dest] = smc.is_epic_arrD
	and is_epic_arrE[elim!] = smc.is_epic_arrE
	and cat_comp_is_monic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_monic_arr
	and cat_comp_is_epic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_epic_arr
	and cat_comp_is_monic_arr_is_monic_arr =
	smc.smc_Comp_is_monic_arr_is_monic_arr
	and cat_is_zero_arr_comp_right[cat_arrow_cs_intros] =
	smc.smc_is_zero_arr_Comp_right
	and cat_is_zero_arr_comp_left[cat_arrow_cs_intros] =
	smc.smc_is_zero_arr_Comp_left

	lemma cat_Comp_is_arr'[cat_cs_intros]:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<CC>' = \<CC>"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> c"
	using assms(1,2) unfolding assms(3) by (rule cat_Comp_is_arr)

	end

	lemmas [cat_cs_simps] = is_idem_arrD(2)

	lemmas [cat_cs_simps] = category.cat_Comp_assoc

	lemmas [cat_cs_intros] =
	category.cat_Comp_vdomainI
	+ category.cat_Hom_in_Vset
	category.cat_is_arrD(1-3)
	category.cat_Comp_is_arr'
	category.cat_Comp_is_arr

	lemmas [cat_arrow_cs_intros] =
	is_monic_arrD(1)
	is_epic_arr_is_arr
	category.cat_comp_is_monic_arr
	category.cat_comp_is_epic_arr
	category.cat_is_zero_arr_comp_right
	category.cat_is_zero_arr_comp_left

	lemmas [cat_cs_intros] = HomI
	lemmas [cat_cs_simps] = in_Hom_iff


	text\<open>Elementary properties.\<close>

	lemma cat_eqI:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	and "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	and "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	and "\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	and "\<AA>\<lparr>CId\<rparr> = \<BB>\<lparr>CId\<rparr>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<AA> = 6\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<AA> \<Longrightarrow> \<AA>\<lparr>a\<rparr> = \<BB>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms) (auto simp: dg_field_simps)
	qed auto
	qed

	lemma cat_smc_eqI:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<AA>\<lparr>CId\<rparr> = \<BB>\<lparr>CId\<rparr>"
	and "cat_smc \<AA> = cat_smc \<BB>"
	shows "\<AA> = \<BB>"
	proof(rule cat_eqI[of \<alpha>])
	from assms(4) have
	"cat_smc \<AA>\<lparr>Obj\<rparr> = cat_smc \<BB>\<lparr>Obj\<rparr>"
	"cat_smc \<AA>\<lparr>Arr\<rparr> = cat_smc \<BB>\<lparr>Arr\<rparr>"
	"cat_smc \<AA>\<lparr>Dom\<rparr> = cat_smc \<BB>\<lparr>Dom\<rparr>"
	"cat_smc \<AA>\<lparr>Cod\<rparr> = cat_smc \<BB>\<lparr>Cod\<rparr>"
	"cat_smc \<AA>\<lparr>Comp\<rparr> = cat_smc \<BB>\<lparr>Comp\<rparr>"
	by auto
	then show
	"\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	"\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	"\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	"\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	"\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	unfolding slicing_simps by simp_all
	qed (auto simp: assms)

	lemma (in category) cat_def:
	"\<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>, \<CC>\<lparr>CId\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<CC> = 6\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>, \<CC>\<lparr>CId\<rparr>]\<^sub>\<circ> = 6\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<CC> = \<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>, \<CC>\<lparr>CId\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<CC> \<Longrightarrow>
	\<CC>\<lparr>a\<rparr> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>, \<CC>\<lparr>CId\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	unfolding dom_lhs
	by elim_in_numeral (simp_all add: dg_field_simps nat_omega_simps)
	qed auto


	text\<open>Size.\<close>

	lemma (in category) cat_CId_vsubset_Vset: "\<CC>\<lparr>CId\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix af assume "af \<in>\<^sub>\<circ> \<CC>\<lparr>CId\<rparr>"
	then obtain a f
	where af_def: "af = \<langle>a, f\<rangle>"
	and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>)"
	and f: "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>)"
	by (auto elim: CId.vbrelation_vinE)
	from a have "a \<in>\<^sub>\<circ> Vset \<alpha>" by (auto simp: cat_cs_simps intro: cat_cs_intros)
	from f cat_CId_vrange have "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by auto
	then have "f \<in>\<^sub>\<circ> Vset \<alpha>" by (auto simp: cat_cs_simps intro: cat_cs_intros)
	then show "af \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: af_def Limit_vpair_in_VsetI \<open>a \<in>\<^sub>\<circ> Vset \<alpha>\<close>)
	qed

	lemma (in category) cat_category_in_Vset_4: "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], cat_cs_intros] =
	cat_Obj_vsubset_Vset
	cat_Arr_vsubset_Vset
	cat_Dom_vsubset_Vset
	cat_Cod_vsubset_Vset
	cat_Comp_vsubset_Vset
	cat_CId_vsubset_Vset
	show ?thesis
	by (subst cat_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps
	cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma (in category) cat_CId_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>CId\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<Z> \<beta> by (rule assms(1))
	from assms have "\<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (auto simp: cat_cs_simps cat_Obj_in_Vset)
	moreover from assms cat_CId_vrange have "\<R>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (auto intro: cat_Arr_in_Vset)
	ultimately show ?thesis by (blast intro: \<Z>_Limit_\<alpha>\<omega>)
	qed

	lemma (in category) cat_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show ?thesis
	proof(rule vsv.vsv_Limit_vsv_in_VsetI)
	have dom: "\<D>\<^sub>\<circ> \<CC> = 6\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	from assms show "\<D>\<^sub>\<circ> \<CC> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dom by (simp add: \<Z>.ord_of_nat_in_Vset)
	have "n \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<CC> \<Longrightarrow> \<CC>\<lparr>n\<rparr> \<in>\<^sub>\<circ> Vset \<beta>" for n
	unfolding dom
	by
	(
	elim_in_numeral,
	all\<open>rewrite in "\<hole> \<in>\<^sub>\<circ> _" dg_field_simps[symmetric]\<close>,
	insert assms
	)
	(
	auto simp:
	cat_Obj_in_Vset
	cat_Arr_in_Vset
	cat_Dom_in_Vset
	cat_Cod_in_Vset
	cat_Comp_in_Vset
	cat_CId_in_Vset
	)
	then show "\<R>\<^sub>\<circ> \<CC> \<subseteq>\<^sub>\<circ> Vset \<beta>" by (metis vsubsetI vrange_atD)
	show "vfinite (\<D>\<^sub>\<circ> \<CC>)" unfolding dom by auto
	qed (simp_all add: \<Z>_Limit_\<alpha>\<omega> vsv_axioms)
	qed

	lemma (in category) cat_category_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "category \<beta> \<CC>"
	by (rule categoryI)
	(
	auto
	intro: cat_cs_intros
	simp: cat_cs_simps assms vfsequence_axioms cat_semicategory_if_ge_Limit
	)

	lemma tiny_category[simp]: "small {\<CC>. category \<alpha> \<CC>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from category.cat_in_Vset[of \<alpha>] show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<CC>. category \<alpha> \<CC>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in \<Z>) categories_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "set {\<CC>. category \<alpha> \<CC>} \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "set {\<CC>. category \<alpha> \<CC>} \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<CC> assume prems: "\<CC> \<in>\<^sub>\<circ> set {\<CC>. category \<alpha> \<CC>}"
	interpret category \<alpha> \<CC> using prems by simp
	show "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	unfolding VPow_iff by (rule cat_category_in_Vset_4)
	qed
	from assms(2) show "Vset (\<alpha> + 4\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma category_if_category:
	assumes "category \<beta> \<CC>"
	and "\<Z> \<alpha>"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "category \<alpha> \<CC>"
	proof-
	interpret category \<beta> \<CC> by (rule assms(1))
	interpret \<alpha>: \<Z> \<alpha> by (rule assms(2))
	show ?thesis
	proof(intro categoryI)
	show "vfsequence \<CC>" by (simp add: vfsequence_axioms)
	show "semicategory \<alpha> (cat_smc \<CC>)"
	by (rule semicategory_if_semicategory, unfold slicing_simps)
	(auto intro!: assms(1,3,4) slicing_intros)
	qed (auto intro: cat_cs_intros simp: cat_cs_simps)
	qed


	text\<open>Further elementary properties.\<close>

	sublocale category \<subseteq> CId: v11 \<open>\<CC>\<lparr>CId\<rparr>\<close>
	proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
	fix a b assume prems:
	"a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	have "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : b \<mapsto>\<^bsub>\<CC>\<^esub> b" "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (subst prems(3))
	(cs_concl cs_simp: cat_cs_simps cs_intro: prems(1,2) cat_cs_intros)+
	with prems show "a = b" by auto (slow)
	qed auto

	lemma (in category) cat_CId_vempty_if_Arr_vempty:
	assumes "\<CC>\<lparr>Arr\<rparr> = 0"
	shows "\<CC>\<lparr>CId\<rparr> = 0"
	using assms cat_CId_vrange by (auto intro: CId.vsv_vrange_vempty)



	subsection\<open>Opposite category\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_cat :: "V \<Rightarrow> V"
	where "op_cat \<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Dom\<rparr>, fflip (\<CC>\<lparr>Comp\<rparr>), \<CC>\<lparr>CId\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_cat_components:
	shows [cat_op_simps]: "op_cat \<CC>\<lparr>Obj\<rparr> = \<CC>\<lparr>Obj\<rparr>"
	and [cat_op_simps]: "op_cat \<CC>\<lparr>Arr\<rparr> = \<CC>\<lparr>Arr\<rparr>"
	and [cat_op_simps]: "op_cat \<CC>\<lparr>Dom\<rparr> = \<CC>\<lparr>Cod\<rparr>"
	and [cat_op_simps]: "op_cat \<CC>\<lparr>Cod\<rparr> = \<CC>\<lparr>Dom\<rparr>"
	and "op_cat \<CC>\<lparr>Comp\<rparr> = fflip (\<CC>\<lparr>Comp\<rparr>)"
	and [cat_op_simps]: "op_cat \<CC>\<lparr>CId\<rparr> = \<CC>\<lparr>CId\<rparr>"
	unfolding op_cat_def dg_field_simps by (auto simp: nat_omega_simps)

	lemma op_cat_component_intros[cat_op_intros]:
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<Longrightarrow> f \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Arr\<rparr>"
	unfolding cat_op_simps by simp_all


	text\<open>Slicing.\<close>

	lemma cat_smc_op_cat[slicing_commute]: "op_smc (cat_smc \<CC>) = cat_smc (op_cat \<CC>)"
	unfolding cat_smc_def op_cat_def op_smc_def dg_field_simps
	by (simp add: nat_omega_simps)

	lemma (in category) op_smc_op_cat[cat_op_simps]: "op_smc (op_cat \<CC>) = cat_smc \<CC>"
	using Comp.pbinop_fflip_fflip
	unfolding op_smc_def op_cat_def cat_smc_def dg_field_simps
	by (simp add: nat_omega_simps)

	lemma op_cat_is_arr[cat_op_simps]: "f : b \<mapsto>\<^bsub>op_cat \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding cat_op_simps is_arr_def by auto

	lemmas [cat_op_intros] = op_cat_is_arr[THEN iffD2]

	lemma op_cat_Hom[cat_op_simps]: "Hom (op_cat \<CC>) a b = Hom \<CC> b a"
	unfolding cat_op_simps by simp

	lemma op_cat_obj_initial[cat_op_simps]:
	"obj_initial (op_cat \<CC>) a \<longleftrightarrow> obj_terminal \<CC> a"
	unfolding obj_initial_def obj_terminal_def
	unfolding smc_op_simps cat_op_simps
	..

	lemmas [cat_op_intros] = op_cat_obj_initial[THEN iffD2]

	lemma op_cat_obj_terminal[cat_op_simps]:
	"obj_terminal (op_cat \<CC>) a \<longleftrightarrow> obj_initial \<CC> a"
	unfolding obj_initial_def obj_terminal_def
	unfolding smc_op_simps cat_op_simps
	..

	lemmas [cat_op_intros] = op_cat_obj_terminal[THEN iffD2]

	lemma op_cat_obj_null[cat_op_simps]: "obj_null (op_cat \<CC>) a \<longleftrightarrow> obj_null \<CC> a"
	unfolding obj_null_def cat_op_simps by auto

	lemmas [cat_op_intros] = op_cat_obj_null[THEN iffD2]

	context category
	begin

	interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	op_cat_Comp_vrange[cat_op_simps] = smc.op_smc_Comp_vrange
	and op_cat_Comp[cat_op_simps] = smc.op_smc_Comp
	and op_cat_is_epic_arr[cat_op_simps] = smc.op_smc_is_epic_arr
	and op_cat_is_monic_arr[cat_op_simps] = smc.op_smc_is_monic_arr
	and op_cat_is_zero_arr[cat_op_simps] = smc.op_smc_is_zero_arr

	end

	lemmas [cat_op_simps] =
	category.op_cat_Comp_vrange
	category.op_cat_Comp
	category.op_cat_is_epic_arr
	category.op_cat_is_monic_arr
	category.op_cat_is_zero_arr

	context
	fixes \<CC> :: V
	begin

	lemmas_with [
	where \<CC>=\<open>cat_smc \<CC>\<close>, unfolded slicing_simps slicing_commute[symmetric]
	]:
	op_cat_Comp_vdomain[cat_op_simps] = op_smc_Comp_vdomain

	end


	text\<open>Elementary properties.\<close>

	lemma op_cat_vsv[cat_op_intros]: "vsv (op_cat \<CC>)" unfolding op_cat_def by auto


	subsubsection\<open>Further properties\<close>

	lemma (in category) category_op[cat_cs_intros]: "category \<alpha> (op_cat \<CC>)"
	proof(intro categoryI, unfold cat_op_simps)
	show "vfsequence (op_cat \<CC>)" unfolding op_cat_def by simp
	show "vcard (op_cat \<CC>) = 6\<^sub>\<nat>"
	unfolding op_cat_def by (simp add: nat_omega_simps)
	next
	fix f a b assume "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	with category_axioms show "\<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f = f"
	by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
	next
	fix f b c assume "f : c \<mapsto>\<^bsub>\<CC>\<^esub> b"
	with category_axioms show "f \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	qed
	(
	auto simp:
	cat_cs_simps
	cat_op_simps
	slicing_commute[symmetric]
	smc_op_intros
	cat_cs_intros
	cat_semicategory
	)

	lemmas category_op[cat_op_intros] = category.category_op

	lemma (in category) cat_op_cat_op_cat[cat_op_simps]: "op_cat (op_cat \<CC>) = \<CC>"
	proof(rule cat_eqI, unfold cat_op_simps op_cat_components)
	show "category \<alpha> (op_cat (op_cat \<CC>))"
	by (simp add: category.category_op category_op)
	show "fflip (fflip (\<CC>\<lparr>Comp\<rparr>)) = \<CC>\<lparr>Comp\<rparr>" by (rule Comp.pbinop_fflip_fflip)
	qed (auto simp: cat_cs_intros)

	lemmas cat_op_cat_op_cat[cat_op_simps] = category.cat_op_cat_op_cat

	lemma eq_op_cat_iff[cat_op_simps]:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>"
	shows "op_cat \<AA> = op_cat \<BB> \<longleftrightarrow> \<AA> = \<BB>"
	proof
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	assume prems: "op_cat \<AA> = op_cat \<BB>"
	show "\<AA> = \<BB>"
	proof(rule cat_eqI)
	show
	"\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	"\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	"\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	"\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	"\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	"\<AA>\<lparr>CId\<rparr> = \<BB>\<lparr>CId\<rparr>"
	by (metis \<AA>.cat_op_cat_op_cat \<BB>.cat_op_cat_op_cat prems)+
	qed (auto intro: cat_cs_intros)
	qed auto



	subsection\<open>Monic arrow and epic arrow\<close>

	lemma (in category) cat_CId_is_monic_arr[cat_arrow_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> a"
	using assms cat_CId_is_arr' cat_CId_left_left by (force intro!: is_monic_arrI)

	lemmas [cat_arrow_cs_intros] = category.cat_CId_is_monic_arr

	lemma (in category) cat_CId_is_epic_arr[cat_arrow_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> a"
	proof-
	from assms have "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>" unfolding cat_op_simps .
	from category.cat_CId_is_monic_arr[OF category_op this, unfolded cat_op_simps]
	show ?thesis.
	qed

	lemmas [cat_arrow_cs_intros] = category.cat_CId_is_epic_arr



	subsection\<open>Right inverse and left inverse of an arrow\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition is_right_inverse :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_right_inverse \<CC> g f =
	(\<exists>a b. g : b \<mapsto>\<^bsub>\<CC>\<^esub> a \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>)"

	definition is_left_inverse :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_left_inverse \<CC> \<equiv> is_right_inverse (op_cat \<CC>)"


	text\<open>Rules.\<close>

	lemma is_right_inverseI:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	shows "is_right_inverse \<CC> g f"
	using assms unfolding is_right_inverse_def by auto

	lemma is_right_inverseD[dest]:
	assumes "is_right_inverse \<CC> g f"
	shows "\<exists>a b. g : b \<mapsto>\<^bsub>\<CC>\<^esub> a \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	using assms unfolding is_right_inverse_def by clarsimp

	lemma is_right_inverseE[elim]:
	assumes "is_right_inverse \<CC> g f"
	obtains a b where "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	using assms by auto

	lemma (in category) is_left_inverseI:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	shows "is_left_inverse \<CC> g f"
	proof-
	from assms(3) have "f \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	unfolding op_cat_Comp[OF assms(1,2)].
	from
	is_right_inverseI[of \<open>op_cat \<CC>\<close>, unfolded cat_op_simps, OF assms(1,2) this]
	show ?thesis
	unfolding is_left_inverse_def .
	qed

	lemma (in category) is_left_inverseD[dest]:
	assumes "is_left_inverse \<CC> g f"
	shows "\<exists>a b. g : b \<mapsto>\<^bsub>\<CC>\<^esub> a \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	proof-
	from is_right_inverseD[OF assms[unfolded is_left_inverse_def]] obtain a b
	where "g : b \<mapsto>\<^bsub>op_cat \<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>op_cat \<CC>\<^esub> b"
	and fg: "f \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> g = op_cat \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by clarsimp
	then have g: "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	unfolding cat_op_simps by simp_all
	moreover from fg have "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	unfolding op_cat_Comp[OF g f] cat_op_simps by simp
	ultimately show ?thesis by blast
	qed

	lemma (in category) is_left_inverseE[elim]:
	assumes "is_left_inverse \<CC> g f"
	obtains a b where "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in category) op_cat_is_left_inverse[cat_op_simps]:
	"is_left_inverse (op_cat \<CC>) g f \<longleftrightarrow> is_right_inverse \<CC> g f"
	unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp

	lemmas [cat_op_simps] = category.op_cat_is_left_inverse

	lemmas [cat_op_intros] = category.op_cat_is_left_inverse[THEN iffD2]

	lemma (in category) op_cat_is_right_inverse[cat_op_simps]:
	"is_right_inverse (op_cat \<CC>) g f \<longleftrightarrow> is_left_inverse \<CC> g f"
	unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp

	lemmas [cat_op_simps] = category.op_cat_is_right_inverse

	lemmas [cat_op_intros] = category.op_cat_is_right_inverse[THEN iffD2]



	subsection\<open>Inverse of an arrow\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition is_inverse :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_inverse \<CC> g f =
	(
	\<exists>a b.
	g : b \<mapsto>\<^bsub>\<CC>\<^esub> a \<and>
	f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and>
	g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<and>
	f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>
	)"


	text\<open>Rules.\<close>

	lemma is_inverseI:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	shows "is_inverse \<CC> g f"
	using assms unfolding is_inverse_def by auto

	lemma is_inverseD[dest]:
	assumes "is_inverse \<CC> g f"
	shows
	"(
	\<exists>a b.
	g : b \<mapsto>\<^bsub>\<CC>\<^esub> a \<and>
	f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and>
	g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<and>
	f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>
	)"
	using assms unfolding is_inverse_def by auto

	lemma is_inverseE[elim]:
	assumes "is_inverse \<CC> g f"
	obtains a b where "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in category) op_cat_is_inverse[cat_op_simps]:
	"is_inverse (op_cat \<CC>) g f \<longleftrightarrow> is_inverse \<CC> g f"
	by (rule iffI; unfold is_inverse_def cat_op_simps) (metis op_cat_Comp)+

	lemmas [cat_op_simps] = category.op_cat_is_inverse

	lemmas [cat_op_intros] = category.op_cat_is_inverse[THEN iffD2]

	lemma is_inverse_sym: "is_inverse \<CC> g f \<longleftrightarrow> is_inverse \<CC> f g"
	unfolding is_inverse_def by auto

	lemma (in category) cat_is_inverse_eq:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "is_inverse \<CC> h f" and "is_inverse \<CC> g f"
	shows "h = g"
	using assms
	proof(elim is_inverseE)
	fix a b a' b'
	assume prems:
	"h : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	"h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	"f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	"g : b' \<mapsto>\<^bsub>\<CC>\<^esub> a'"
	"f : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	"g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a'\<rparr>"
	then have ab: "a' = a" "b' = b" by auto
	from prems have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>" and g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	unfolding ab by simp_all
	from prems(1) have "h = (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	unfolding gf by (simp add: cat_cs_simps)
	also with category_axioms prems(1,2) g have "\<dots> = g"
	by
	(
	cs_concl cs_shallow
	cs_simp: prems(4) cat_cs_simps cs_intro: cat_cs_intros
	)
	finally show "h = g" by simp
	qed

	lemma is_inverse_Comp_CId_left:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "is_inverse \<CC> g' g" and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	using assms by auto

	lemma is_inverse_Comp_CId_right:
	assumes "is_inverse \<CC> g' g" and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g' = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by (metis assms is_arrD(3) is_inverseE)

	lemma (in category) cat_is_inverse_Comp:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes gbc[intro]: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and fab[intro]: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and g'g[intro]: "is_inverse \<CC> g' g"
	and f'f[intro]: "is_inverse \<CC> f' f"
	shows "is_inverse \<CC> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g') (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	proof-
	from g'g gbc f'f fab have g'cb: "g' : c \<mapsto>\<^bsub>\<CC>\<^esub> b" and f'ba: "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (metis is_arrD(2,3) is_inverseD)+
	with assms have f'g': "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g' : c \<mapsto>\<^bsub>\<CC>\<^esub> a" and gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (auto intro: cat_Comp_is_arr)
	have ff': "is_inverse \<CC> f f'" using assms by (simp add: is_inverse_sym)
	note [simp] =
	cat_Comp_assoc[symmetric, OF f'g' gbc fab]
	cat_Comp_assoc[OF f'ba g'cb gbc]
	is_inverse_Comp_CId_left[OF g'g gbc]
	cat_Comp_assoc[symmetric, OF gf f'ba g'cb]
	cat_Comp_assoc[OF gbc fab f'ba]
	is_inverse_Comp_CId_left[OF ff' f'ba]
	cat_CId_right_left[OF f'ba]
	cat_CId_right_left[OF gbc]
	show ?thesis
	by (intro is_inverseI, rule f'g', rule gf)
	(auto intro: is_inverse_Comp_CId_left is_inverse_Comp_CId_right)
	qed

	lemma (in category) cat_is_inverse_Comp':
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "is_inverse \<CC> g' g"
	and "is_inverse \<CC> f' f"
	and "f'g' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	and "gf = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	shows "is_inverse \<CC> f'g' gf"
	using assms(1-4) unfolding assms(5,6) by (intro cat_is_inverse_Comp)

	lemmas [cat_cs_intros] = category.cat_is_inverse_Comp'

	lemma is_inverse_is_right_inverse[dest]:
	assumes "is_inverse \<CC> g f"
	shows "is_right_inverse \<CC> g f"
	using assms by (auto intro: is_right_inverseI)

	lemma (in category) cat_is_inverse_is_left_inverse[dest]:
	assumes "is_inverse \<CC> g f"
	shows "is_left_inverse \<CC> g f"
	proof-
	interpret op: category \<alpha> \<open>op_cat \<CC>\<close> by (auto intro!: cat_cs_intros)
	from assms have "is_inverse (op_cat \<CC>) g f" by (simp add: cat_op_simps)
	from is_inverse_is_right_inverse[OF this] show ?thesis
	unfolding is_left_inverse_def .
	qed

	lemma (in category) cat_is_right_left_inverse_is_inverse:
	assumes "is_right_inverse \<CC> g f" "is_left_inverse \<CC> g f"
	shows "is_inverse \<CC> g f"
	using assms
	proof(elim is_right_inverseE is_left_inverseE)
	fix a b c d assume prems:
	"g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	"f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	"g : d \<mapsto>\<^bsub>\<CC>\<^esub> c"
	"f : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
	"g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>"
	then have dbca: "d = b" "c = a" by auto
	note [cat_cs_simps] = prems(3,6)[unfolded dbca]
	from prems(1,2) show "is_inverse \<CC> g f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_inverseI
	)
	qed



	subsection\<open>Isomorphism\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	-definition is_arr_isomorphism :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- where "is_arr_isomorphism \<CC> a b f \<longleftrightarrow>
	+definition is_iso_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "is_iso_arr \<CC> a b f \<longleftrightarrow>
	(f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> (\<exists>g. is_inverse \<CC> g f))"

	-syntax "_is_arr_isomorphism" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+syntax "_is_iso_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>_ : _ \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<index> _\<close> [51, 51, 51] 51)
	-translations "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_arr_isomorphism \<CC> a b f"
	+translations "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_iso_arr \<CC> a b f"


	text\<open>Rules.\<close>

	-lemma is_arr_isomorphismI:
	+lemma is_iso_arrI:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "is_inverse \<CC> g f"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	- using assms unfolding is_arr_isomorphism_def by auto
	+ using assms unfolding is_iso_arr_def by auto

	-lemma is_arr_isomorphismD[dest]:
	+lemma is_iso_arrD[dest]:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "\<exists>g. is_inverse \<CC> g f"
	- using assms unfolding is_arr_isomorphism_def by auto
	+ using assms unfolding is_iso_arr_def by auto

	-lemma is_arr_isomorphismE[elim]:
	+lemma is_iso_arrE[elim]:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	obtains g where "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "is_inverse \<CC> g f"
	using assms by force

	-lemma is_arr_isomorphismE':
	+lemma is_iso_arrE':
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	obtains g where "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	proof-
	from assms obtain g where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" "is_inverse \<CC> g f" by auto
	then have "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and fg: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by auto
	then have g: "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	- by (cs_concl cs_shallow cs_intro: is_inverseI is_arr_isomorphismI)
	+ by (cs_concl cs_shallow cs_intro: is_inverseI is_iso_arrI)
	from that f g gf fg show ?thesis by simp
	qed


	text\<open>Elementary properties.\<close>

	-lemma (in category) op_cat_is_arr_isomorphism[cat_op_simps]:
	+lemma (in category) op_cat_is_iso_arr[cat_op_simps]:
	"f : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>op_cat \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	- unfolding is_arr_isomorphism_def cat_op_simps by simp
	+ unfolding is_iso_arr_def cat_op_simps by simp

	-lemmas [cat_op_simps] = category.op_cat_is_arr_isomorphism
	+lemmas [cat_op_simps] = category.op_cat_is_iso_arr

	-lemmas [cat_op_intros] = category.op_cat_is_arr_isomorphism[THEN iffD2]
	+lemmas [cat_op_intros] = category.op_cat_is_iso_arr[THEN iffD2]

	-lemma (in category) is_arr_isomorphismI':
	+lemma (in category) is_iso_arrI':
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" and "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	proof-
	from assms have gf: "is_inverse \<CC> g f" by (auto intro: is_inverseI)
	from assms have fg: "is_inverse \<CC> f g" by (auto intro: is_inverseI)
	show "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" and "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	by
	(
	intro
	- is_arr_isomorphismI[OF assms(1) gf]
	- is_arr_isomorphismI[OF assms(2) fg]
	+ is_iso_arrI[OF assms(1) gf]
	+ is_iso_arrI[OF assms(2) fg]
	)+
	qed

	-lemma (in category) cat_is_inverse_is_arr_isomorphism:
	+lemma (in category) cat_is_inverse_is_iso_arr:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "is_inverse \<CC> g f"
	shows "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	from assms(2) obtain a' b'
	where g: "g : b' \<mapsto>\<^bsub>\<CC>\<^esub> a'"
	and f: "f : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	and gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a'\<rparr>"
	and fg: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b'\<rparr>"
	by auto
	with assms(1) have a'b': "a' = a" "b' = b" by auto
	from g f gf fg show
	"g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	"g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	"g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	unfolding a'b' by auto
	qed

	-lemma (in category) cat_Comp_is_arr_isomorphism[cat_arrow_cs_intros]:
	+lemma (in category) cat_Comp_is_iso_arr[cat_arrow_cs_intros]:
	assumes "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> c"
	proof-
	from assms have [intro]: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (auto intro: cat_cs_intros)
	from assms(1) obtain g' where g'g: "is_inverse \<CC> g' g" by force
	with assms(1) have [intro]: "g' : c \<mapsto>\<^bsub>\<CC>\<^esub> b"
	- by (elim is_arr_isomorphismE)
	- (auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
	+ by (elim is_iso_arrE)
	+ (auto simp: is_iso_arrD cat_is_inverse_is_iso_arr)
	from assms(2) obtain f' where f'f: "is_inverse \<CC> f' f" by auto
	with assms(2) have [intro]: "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	- by (elim is_arr_isomorphismE)
	- (auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
	+ by (elim is_iso_arrE)
	+ (auto simp: is_iso_arrD cat_is_inverse_is_iso_arr)
	have "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g' : c \<mapsto>\<^bsub>\<CC>\<^esub> a" by (auto intro: cat_cs_intros)
	from cat_is_inverse_Comp[OF _ _ g'g f'f] assms
	have "is_inverse \<CC> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g') (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	- by (elim is_arr_isomorphismE) simp
	- then show ?thesis by (auto intro: is_arr_isomorphismI)
	+ by (elim is_iso_arrE) simp
	+ then show ?thesis by (auto intro: is_iso_arrI)
	qed

	-lemmas [cat_arrow_cs_intros] = category.cat_Comp_is_arr_isomorphism
	+lemmas [cat_arrow_cs_intros] = category.cat_Comp_is_iso_arr

	-lemma (in category) cat_CId_is_arr_isomorphism:
	+lemma (in category) cat_CId_is_iso_arr:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	using assms
	by
	(
	cs_concl cs_shallow
	- cs_intro: cat_cs_intros is_inverseI cat_is_inverse_is_arr_isomorphism
	+ cs_intro: cat_cs_intros is_inverseI cat_is_inverse_is_iso_arr
	cs_simp: cat_cs_simps
	)

	-lemma (in category) cat_CId_is_arr_isomorphism'[cat_arrow_cs_intros]:
	+lemma (in category) cat_CId_is_iso_arr'[cat_arrow_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<CC>' = \<CC>"
	and "b = a"
	and "c = a"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> c"
	using assms(1)
	unfolding assms(2-4)
	- by (rule cat_CId_is_arr_isomorphism)
	+ by (rule cat_CId_is_iso_arr)

	-lemmas [cat_arrow_cs_intros] = category.cat_CId_is_arr_isomorphism'
	+lemmas [cat_arrow_cs_intros] = category.cat_CId_is_iso_arr'

	-lemma (in category) cat_is_arr_isomorphism_is_monic_arr[cat_arrow_cs_intros]:
	+lemma (in category) cat_is_iso_arr_is_monic_arr[cat_arrow_cs_intros]:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b"
	proof(intro is_monic_arrI)
	- note [cat_cs_intros] = is_arr_isomorphismD(1)
	- show "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by (intro is_arr_isomorphismD(1)[OF assms])
	+ note [cat_cs_intros] = is_iso_arrD(1)
	+ show "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by (intro is_iso_arrD(1)[OF assms])
	fix h g c assume prems:
	"h : c \<mapsto>\<^bsub>\<CC>\<^esub> a" "g : c \<mapsto>\<^bsub>\<CC>\<^esub> a" "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	from assms obtain f'
	where f': "f' : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	- by (auto elim: is_arr_isomorphismE')
	+ by (auto elim: is_iso_arrE')
	from category_axioms assms prems(1,2) have "h = (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from category_axioms assms prems(1,2) f' have "\<dots> = (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	by (cs_concl cs_simp: prems(3) cat_cs_simps cs_intro: cat_cs_intros)
	also from category_axioms assms prems(1,2) f' have "\<dots> = g"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	finally show "h = g" by simp
	qed

	-lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_monic_arr
	+lemmas [cat_arrow_cs_intros] = category.cat_is_iso_arr_is_monic_arr

	-lemma (in category) cat_is_arr_isomorphism_is_epic_arr:
	+lemma (in category) cat_is_iso_arr_is_epic_arr:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	using assms
	by
	(
	rule
	- category.cat_is_arr_isomorphism_is_monic_arr[
	+ category.cat_is_iso_arr_is_monic_arr[
	OF category_op, unfolded cat_op_simps
	]
	)

	-lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_epic_arr
	+lemmas [cat_arrow_cs_intros] = category.cat_is_iso_arr_is_epic_arr

	-lemma (in category) cat_is_arr_isomorphism_if_is_monic_arr_is_right_inverse:
	+lemma (in category) cat_is_iso_arr_if_is_monic_arr_is_right_inverse:
	assumes "f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b" and "is_right_inverse \<CC> g f"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	proof-
	note f_is_monic_arrD = is_monic_arrD[OF assms(1)]
	from is_right_inverseD[OF assms(2)] f_is_monic_arrD(1)
	have g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a" and fg: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by auto
	from f_is_monic_arrD(1) g have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from g have CId_a: "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show ?thesis
	proof
	(
	intro
	- is_arr_isomorphismI
	+ is_iso_arrI
	cat_is_right_left_inverse_is_inverse
	is_left_inverseI,
	rule f_is_monic_arrD(1),
	rule assms(2),
	rule g,
	rule f_is_monic_arrD(1)
	)
	from f_is_monic_arrD(1) g have "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from f_is_monic_arrD(1) g have "\<dots> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps fg cs_intro: cat_cs_intros)
	finally have "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>" by simp
	from f_is_monic_arrD(2)[OF gf CId_a this] show "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>".
	qed
	qed

	-lemma (in category) cat_is_arr_isomorphism_if_is_epic_arr_is_left_inverse:
	+lemma (in category) cat_is_iso_arr_if_is_epic_arr_is_left_inverse:
	assumes "f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b" and "is_left_inverse \<CC> g f"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	using assms
	by
	(
	- rule category.cat_is_arr_isomorphism_if_is_monic_arr_is_right_inverse[
	+ rule category.cat_is_iso_arr_if_is_monic_arr_is_right_inverse[
	OF category_op, unfolded cat_op_simps
	]
	)



	subsection\<open>The inverse arrow\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition the_inverse :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_\<inverse>\<^sub>C\<index>)\<close> [1000] 999)
	where "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = (THE g. is_inverse \<CC> g f)"


	text\<open>Elementary properties.\<close>

	lemma (in category) cat_is_inverse_is_inverse_the_inverse:
	assumes "is_inverse \<CC> g f"
	shows "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f"
	unfolding the_inverse_def
	proof(rule theI)
	fix g' assume "is_inverse \<CC> g' f"
	then show "g' = g" by (meson cat_is_inverse_eq assms)
	qed (rule assms)

	lemma (in category) cat_is_inverse_eq_the_inverse:
	assumes "is_inverse \<CC> g f"
	shows "g = f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	by (meson assms cat_is_inverse_is_inverse_the_inverse cat_is_inverse_eq)


	text\<open>The inverse arrow is an inverse of an isomorphism.\<close>

	lemma (in category) cat_the_inverse_is_inverse:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f"
	proof-
	from assms obtain g where "is_inverse \<CC> g f" by auto
	then show "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f"
	by (rule cat_is_inverse_is_inverse_the_inverse)
	qed

	-lemma (in category) cat_the_inverse_is_arr_isomorphism:
	+lemma (in category) cat_the_inverse_is_iso_arr:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	proof-
	from assms have f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto
	have "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f" by (rule cat_the_inverse_is_inverse[OF assms])
	- from cat_is_inverse_is_arr_isomorphism[OF f this] show ?thesis .
	+ from cat_is_inverse_is_iso_arr[OF f this] show ?thesis .
	qed

	-lemma (in category) cat_the_inverse_is_arr_isomorphism':
	+lemma (in category) cat_the_inverse_is_iso_arr':
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" and "\<CC>' = \<CC>"
	shows "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> a"
	using assms(1)
	unfolding assms(2)
	- by (rule cat_the_inverse_is_arr_isomorphism)
	+ by (rule cat_the_inverse_is_iso_arr)

	-lemmas [cat_cs_intros] = category.cat_the_inverse_is_arr_isomorphism'
	+lemmas [cat_cs_intros] = category.cat_the_inverse_is_iso_arr'

	lemma (in category) op_cat_the_inverse:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f\<inverse>\<^sub>C\<^bsub>op_cat \<CC>\<^esub> = f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	proof-
	from assms have "f : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>op_cat \<CC>\<^esub> a" unfolding cat_op_simps by simp
	from assms show ?thesis
	by
	(
	intro
	category.cat_is_inverse_eq_the_inverse[
	symmetric, OF category_op, unfolded cat_op_simps
	]
	cat_the_inverse_is_inverse
	)
	qed

	lemmas [cat_op_simps] = category.op_cat_the_inverse

	lemma (in category) cat_Comp_the_inverse:
	assumes "g : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	proof-
	from assms have "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_intro: cat_arrow_cs_intros)
	then have inv_gf: "is_inverse \<CC> ((g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	by (intro cat_the_inverse_is_inverse)
	from assms have "is_inverse \<CC> (g\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) g" "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f"
	by (auto intro: cat_the_inverse_is_inverse)
	with category_axioms assms have
	"is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_arrow_cs_intros)
	from inv_gf this show "(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	by (meson cat_is_inverse_eq)
	qed

	lemmas [cat_cs_simps] = category.cat_Comp_the_inverse

	lemma (in category) cat_the_inverse_Comp_CId:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows cat_the_inverse_Comp_CId_left: "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	and cat_the_inverse_Comp_CId_right: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	proof-
	from assms show "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: is_inverse_Comp_CId_left
	cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
	)
	from assms show "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl
	cs_simp: is_inverse_Comp_CId_right
	cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
	)
	qed

	lemmas [cat_cs_simps] = category.cat_the_inverse_Comp_CId

	lemma (in category) cat_the_inverse_the_inverse:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "(f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = f"
	proof-
	- from assms have
	- "(f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ from assms have "(f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	also from assms have "\<dots> = f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	finally show ?thesis .
	qed

	lemmas [cat_cs_simps] = category.cat_the_inverse_the_inverse



	subsection\<open>Isomorphic objects\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition obj_iso :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "obj_iso \<CC> a b \<longleftrightarrow> (\<exists>f. f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b)"

	syntax "_obj_iso" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool" (\<open>(_/ \<approx>\<^sub>o\<^sub>b\<^sub>j\<index> _)\<close> [55, 56] 55)
	translations "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST obj_iso \<CC> a b"


	text\<open>Rules.\<close>

	lemma obj_isoI:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b"
	using assms unfolding obj_iso_def by auto

	lemma obj_isoD[dest]:
	assumes "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b"
	shows "\<exists>f. f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	using assms unfolding obj_iso_def by auto

	lemma obj_isoE[elim!]:
	assumes "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b"
	obtains f where "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in category) op_cat_obj_iso[cat_op_simps]:
	"a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>op_cat \<CC>\<^esub> b = b \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> a"
	unfolding obj_iso_def cat_op_simps ..

	lemmas [cat_op_simps] = category.op_cat_obj_iso

	lemmas [cat_op_intros] = category.op_cat_obj_iso[THEN iffD2]


	text\<open>Equivalence relation.\<close>

	lemma (in category) cat_obj_iso_refl:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> a"
	using assms by (auto intro: obj_isoI cat_arrow_cs_intros)

	lemma (in category) cat_obj_iso_sym[sym]:
	assumes "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b"
	shows "b \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> a"
	using assms
	- by (elim obj_isoE is_arr_isomorphismE)
	- (metis obj_iso_def cat_is_inverse_is_arr_isomorphism)
	+ by (elim obj_isoE is_iso_arrE)
	+ (metis obj_iso_def cat_is_inverse_is_iso_arr)

	lemma (in category) cat_obj_iso_trans[trans]:
	assumes "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b" and "b \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> c"
	shows "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> c"
	- using assms by (auto intro: cat_Comp_is_arr_isomorphism obj_isoI)
	+ using assms by (auto intro: cat_Comp_is_iso_arr obj_isoI)



	subsection\<open>Terminal object and initial object\<close>

	lemma (in category) cat_obj_terminal_CId:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "obj_terminal \<CC> a" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> = f"
	using assms by (elim obj_terminalE) (metis cat_CId_is_arr)

	lemma (in category) cat_obj_initial_CId:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "obj_initial \<CC> a" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> = f"
	using assms
	by (rule category.cat_obj_terminal_CId[OF category_op, unfolded cat_op_simps])

	lemma (in category) cat_obj_terminal_obj_iso:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "obj_terminal \<CC> a" and "obj_terminal \<CC> a'"
	shows "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> a'"
	proof-
	from assms obtain f where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a'" by auto
	from assms obtain f' where f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a" by auto
	from f f' cat_obj_terminal_CId cat_Comp_is_arr
	have f'f: "is_inverse \<CC> f' f"
	by (intro is_inverseI[OF f' f]) (metis assms(1), metis assms(2))
	with f show ?thesis
	- by (cs_concl cs_shallow cs_intro: obj_isoI is_arr_isomorphismI)
	+ by (cs_concl cs_shallow cs_intro: obj_isoI is_iso_arrI)
	qed

	lemma (in category) cat_obj_initial_obj_iso:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "obj_initial \<CC> a" and "obj_initial \<CC> a'"
	shows "a' \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> a"
	proof-
	interpret op: category \<alpha> \<open>op_cat \<CC>\<close> by (auto intro: cat_cs_intros)
	from assms show ?thesis
	by (rule op.cat_obj_terminal_obj_iso[unfolded cat_op_simps])
	qed



	subsection\<open>Null object\<close>

	lemma (in category) cat_obj_null_obj_iso:
	- \<comment>\<open>see Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	+ \<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "obj_null \<CC> z" and "obj_null \<CC> z'"
	shows "z \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> z'"
	using assms by (simp add: cat_obj_terminal_obj_iso obj_nullD(2))



	subsection\<open>Groupoid\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	locale groupoid = category \<alpha> \<CC> for \<alpha> \<CC> +
	- assumes grpd_is_arr_isomorphism: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	+ assumes grpd_is_iso_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<Longrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"


	text\<open>Rules.\<close>

	mk_ide rf groupoid_def[unfolded groupoid_axioms_def]
	\|intro groupoidI\|
	\|dest groupoidD[dest]\|
	\|elim groupoidE[elim]\|

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
	@@ -1,4861 +1,5202 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Comma categories\<close>
	theory CZH_ECAT_Comma
	imports
	CZH_ECAT_NTCF
	CZH_ECAT_Simple
	begin



	subsection\<open>Background\<close>

	named_theorems cat_comma_cs_simps
	named_theorems cat_comma_cs_intros



	subsection\<open>Comma category\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	See Exercise 1.3.vi in \cite{riehl_category_2016} or
	Chapter II-6 in \cite{mac_lane_categories_2010}.
	\<close>

	definition cat_comma_Obj :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cat_comma_Obj \<GG> \<HH> \<equiv> set
	{
	[a, b, f]\<^sub>\<circ> \| a b f.
	a \<in>\<^sub>\<circ> \<GG>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
	b \<in>\<^sub>\<circ> \<HH>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
	f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
	}"

	lemma small_cat_comma_Obj[simp]:
	"small
	{
	[a, b, f]\<^sub>\<circ> \| a b f.
	a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<and> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<and> f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
	}"
	(is \<open>small ?abfs\<close>)
	proof-
	define Q where
	"Q i = (if i = 0 then \<AA>\<lparr>Obj\<rparr> else if i = 1\<^sub>\<nat> then \<BB>\<lparr>Obj\<rparr> else \<CC>\<lparr>Arr\<rparr>)"
	for i
	have "?abfs \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	unfolding Q_def
	proof
	(
	intro subsetI,
	unfold mem_Collect_eq,
	elim exE conjE,
	intro vproductI;
	simp only:
	)
	fix a b f show "\<D>\<^sub>\<circ> [a, b, f]\<^sub>\<circ> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	by (simp add: three nat_omega_simps)
	qed (force simp: nat_omega_simps)+
	then show "small ?abfs" by (rule down)
	qed

	definition cat_comma_Hom :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cat_comma_Hom \<GG> \<HH> A B \<equiv> set
	{
	[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \| g h.
	A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> B\<lparr>0\<rparr> \<and>
	h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
	B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
	\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
	}"

	lemma small_cat_comma_Hom[simp]: "small
	{
	[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \| g h.
	A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> B\<lparr>0\<rparr> \<and>
	h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
	B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
	}"
	(is \<open>small ?abf_a'b'f'_gh\<close>)
	proof-
	define Q where
	"Q i =
	(
	if i = 0
	then cat_comma_Obj \<GG> \<HH>
	else if i = 1\<^sub>\<nat> then cat_comma_Obj \<GG> \<HH> else \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>
	)"
	for i
	have "?abf_a'b'f'_gh \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	unfolding Q_def
	proof
	(
	intro subsetI,
	unfold mem_Collect_eq,
	elim exE conjE,
	intro vproductI;
	simp only:
	)
	fix a b f show "\<D>\<^sub>\<circ> [a, b, f]\<^sub>\<circ> = ZFC_in_HOL.set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	by (simp add: three nat_omega_simps)
	qed (force simp : nat_omega_simps)+
	then show "small ?abf_a'b'f'_gh" by (rule down)
	qed

	definition cat_comma_Arr :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cat_comma_Arr \<GG> \<HH> \<equiv>
	(
	\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
	cat_comma_Hom \<GG> \<HH> A B
	)"

	definition cat_comma_composable :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cat_comma_composable \<GG> \<HH> \<equiv> set
	{
	[[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ> \| A B C G F.
	[B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and> [A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
	}"

	lemma small_cat_comma_composable[simp]:
	shows "small
	{
	[[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ> \| A B C G F.
	[B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and> [A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
	}"
	(is \<open>small ?S\<close>)
	proof(rule down)
	show "?S \<subseteq> elts (cat_comma_Arr \<GG> \<HH> \<times>\<^sub>\<bullet> cat_comma_Arr \<GG> \<HH>)" by auto
	qed

	definition cat_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
	where "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> =
	[
	cat_comma_Obj \<GG> \<HH>,
	cat_comma_Arr \<GG> \<HH>,
	(\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>),
	(\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>),
	(
	\<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
	[
	GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
	[
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	]\<^sub>\<circ>
	),
	(
	\<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
	[A, A, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
	)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_comma_components:
	shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> = cat_comma_Obj \<GG> \<HH>"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> = cat_comma_Arr \<GG> \<HH>"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr> =
	(
	\<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
	[
	GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
	[
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	]\<^sub>\<circ>
	)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr> =
	(
	\<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
	[A, A, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
	)"
	unfolding cat_comma_def dg_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<GG> \<HH>
	assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<HH>: "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule \<GG>)
	interpretation \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule \<HH>)

	lemma cat_comma_Obj_def':
	"cat_comma_Obj \<GG> \<HH> \<equiv> set
	{
	[a, b, f]\<^sub>\<circ> \| a b f.
	a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<and> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<and> f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
	}"
	unfolding cat_comma_Obj_def cat_cs_simps by simp

	lemma cat_comma_Hom_def':
	"cat_comma_Hom \<GG> \<HH> A B \<equiv> set
	{
	[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \| g h.
	A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
	g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> B\<lparr>0\<rparr> \<and>
	h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
	B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
	}"
	unfolding cat_comma_Hom_def cat_cs_simps by simp

	lemma cat_comma_components':
	shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> = cat_comma_Obj \<GG> \<HH>"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> = cat_comma_Arr \<GG> \<HH>"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr> =
	(
	\<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
	[
	GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
	[
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
	GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	]\<^sub>\<circ>
	)"
	and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr> =
	(\<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
	unfolding cat_comma_components cat_cs_simps by simp_all

	end


	subsubsection\<open>Objects\<close>

	lemma cat_comma_ObjI[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	using assms(4-6)
	unfolding cat_comma_Obj_def'[OF assms(1,2)] assms(3) cat_comma_components
	by simp

	lemma cat_comma_ObjD[dest]:
	assumes "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	using assms
	unfolding
	cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)]
	by auto

	lemma cat_comma_ObjE[elim]:
	assumes "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains a b f where "A = [a, b, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	using assms
	unfolding
	cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)]
	by auto


	subsubsection\<open>Arrows\<close>

	lemma cat_comma_HomI[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	shows "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	using assms(1,2,6-10)
	unfolding cat_comma_Hom_def'[OF assms(1,2)] assms(3-5)
	by
	(
	intro in_set_CollectI exI conjI small_cat_comma_Hom,
	unfold cat_comma_components'(1,2)[OF assms(1,2), symmetric],
	(
	cs_concl
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+
	)
	(clarsimp simp: nat_omega_simps)+

	lemma cat_comma_HomE[elim]:
	assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains a b f a' b' f' g h
	where "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	using assms(1)
	by
	(
	unfold
	cat_comma_components'[OF assms(2,3)] cat_comma_Hom_def'[OF assms(2,3)],
	elim in_small_setE;
	(unfold mem_Collect_eq, elim exE conjE cat_comma_ObjE[OF _ assms(2,3)])?,
	insert that,
	all\<open>
	(unfold cat_comma_components'(1,2)[OF assms(2,3), symmetric],
	elim cat_comma_ObjE[OF _ assms(2,3)]) \| -
	\<close>
	)
	(auto simp: nat_omega_simps)

	lemma cat_comma_HomD[dest]:
	assumes "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	using assms(1) by (force elim!: cat_comma_HomE[OF _ assms(2,3)])+

	lemma cat_comma_ArrI[cat_comma_cs_intros]:
	assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	shows "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	using assms
	unfolding cat_comma_components cat_comma_Arr_def
	by (intro vifunionI)

	lemma cat_comma_ArrE[elim]:
	assumes "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	obtains A B
	where "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	using assms unfolding cat_comma_components cat_comma_Arr_def by auto

	lemma cat_comma_ArrD[dest]:
	assumes "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	proof-
	from assms obtain C D
	where "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> C D"
	and "C \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "D \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by (elim cat_comma_ArrE)
	moreover from cat_comma_HomE[OF this(1) assms(2,3)] have "A = C" and "B = D"
	by auto
	ultimately show "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by auto
	qed


	subsubsection\<open>Domain\<close>

	lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>)"
	unfolding cat_comma_components by simp

	lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	unfolding cat_comma_components by simp

	lemma cat_comma_Dom_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
	using assms(2) unfolding assms(1) cat_comma_components by simp

	lemma cat_comma_Dom_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset)
	fix ABF assume "ABF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>)"
	then have "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_comma_cs_simps)
	then obtain A B
	where ABF: "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and A: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by auto
	from this(1) obtain a b f a' b' f' g h
	where "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (elim cat_comma_HomE[OF _ assms(1,2)])
	from ABF this A B show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	qed (auto intro: cat_comma_cs_intros)


	subsubsection\<open>Codomain\<close>

	lemma cat_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>)"
	unfolding cat_comma_components by simp

	lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	unfolding cat_comma_components by simp

	lemma cat_comma_Cod_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	using assms(2)
	unfolding assms(1) cat_comma_components
	by (simp add: nat_omega_simps)

	lemma cat_comma_Cod_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset)
	fix ABF assume "ABF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>)"
	then have "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_comma_cs_simps)
	then obtain A B
	where F: "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	and A: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by auto
	from this(1) obtain a b f a' b' f' g h
	where "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (elim cat_comma_HomE[OF _ assms(1,2)])
	from F this A B show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	qed (auto intro: cat_comma_cs_intros)


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma cat_comma_is_arrI[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "ABF = [A, B, F]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "F = [g, h]\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	shows "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	proof(intro is_arrI)
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	from assms(7-11) show "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	unfolding assms(3-6)
	by
	(
	cs_concl
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	with assms(7-11) show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	unfolding assms(3-6) by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
	qed

	lemma cat_comma_is_arrD[dest]:
	assumes "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> :
	[a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> [a', b', f']\<^sub>\<circ>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	proof-
	note F_is_arrD = is_arrD[OF assms(1)]
	note F_cat_comma_ArrD = cat_comma_ArrD[OF F_is_arrD(1) assms(2,3)]
	show "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+
	qed

	lemma cat_comma_is_arrE[elim]:
	assumes "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains a b f a' b' f' g h
	where "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	proof-
	note F_is_arrD = is_arrD[OF assms(1)]
	from F_is_arrD(1) obtain C D
	where "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> C D"
	and "C \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "D \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by auto
	from this(1) obtain a b f a' b' f' g h
	where F_def: "ABF = [C, D, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "C = [a, b, f]\<^sub>\<circ>"
	and "D = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (elim cat_comma_HomE[OF _ assms(2,3)])
	with that show ?thesis
	by (metis F_is_arrD(1,2,3) cat_comma_Cod_app cat_comma_Dom_app)
	qed


	subsubsection\<open>Composition\<close>

	lemma cat_comma_composableI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "ABCGF = [BCG, ABF]\<^sub>\<circ>"
	and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	shows "ABCGF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
	proof-
	from assms(1,2,5) obtain a b f a' b' f' gh
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, gh]\<^sub>\<circ>"
	and "A = [a, b, f]\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	by auto
	with assms(1,2,4) obtain a'' b'' f'' g'h'
	where BCG_def: "BCG = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, g'h']\<^sub>\<circ>"
	and "B = [a', b', f']\<^sub>\<circ>"
	and "C = [a'', b'', f'']\<^sub>\<circ>"
	by auto
	from is_arrD(1)[OF assms(4)] have "BCG \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
	unfolding cat_comma_components'(2)[OF assms(1,2)].
	moreover from is_arrD(1)[OF assms(5)] have "ABF \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
	unfolding cat_comma_components'(2)[OF assms(1,2)].
	ultimately show ?thesis
	unfolding assms(3) ABF_def BCG_def cat_comma_composable_def
	by simp
	qed

	lemma cat_comma_composableE[elim]:
	assumes "ABCGF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains BCG ABF A B C
	where "ABCGF = [BCG, ABF]\<^sub>\<circ>"
	and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	proof-
	from assms(1) obtain A B C G F
	where ABCGF_def: "ABCGF = [[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ>"
	and BCG: "[B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	and ABF: "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	unfolding cat_comma_composable_def
	by (auto simp: cat_comma_components'[OF assms(2,3)])
	note BCG = cat_comma_ArrD[OF BCG assms(2,3)]
	and ABF = cat_comma_ArrD[OF ABF assms(2,3)]
	from ABF(1) assms(2,3) obtain a b f a' b' f' g h
	where "[A, B, F]\<^sub>\<circ> = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and F_def: "F = [g, h]\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [cat_comma_cs_simps]:
	"f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with BCG(1) assms(2,3) obtain a'' b'' f'' g' h'
	where g'h'_def: "[B, C, G]\<^sub>\<circ> = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
	and G_def: "G = [g', h']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_comma_cs_simps]:
	"f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto
	from F_def have "F = [g, h]\<^sub>\<circ>" by simp
	from assms(2,3) g h f f' g' h' f'' have
	"[B, C, G]\<^sub>\<circ> : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	unfolding ABCGF_def F_def G_def A_def B_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI
	)+
	moreover from assms(2,3) g h f f' g' h' f'' have
	"[A, B, F]\<^sub>\<circ> : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	unfolding ABCGF_def F_def G_def A_def B_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI
	)+
	ultimately show ?thesis using that ABCGF_def by auto
	qed

	lemma cat_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>)"
	unfolding cat_comma_components by auto

	lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>) = cat_comma_composable \<GG> \<HH>"
	unfolding cat_comma_components by auto

	lemma cat_comma_Comp_app[cat_comma_cs_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "G = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	shows "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F = [A, C, [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, h' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> h]\<^sub>\<circ>]\<^sub>\<circ>"
	using assms(1,2,5,6)
	unfolding cat_comma_components'[OF assms(1,2)] assms(3,4)
	by (slow)
	(
	cs_concl
	cs_simp: omega_of_set V_cs_simps vfsequence_simps
	cs_intro: nat_omega_intros V_cs_intros cat_comma_composableI TrueI
	)

	lemma cat_comma_Comp_is_arr[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	shows "BCG \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	from assms(1,2,4) obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [symmetric, cat_cs_simps]:
	"f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with assms(1,2,3) obtain a'' b'' f'' g' h'
	where BCG_def: "BCG = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto (slow)
	from g' have \<GG>g': "\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	note [cat_cs_simps] =
	category.cat_assoc_helper[
	where \<CC>=\<CC> and h=f'' and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	category.cat_assoc_helper[
	where \<CC>=\<CC> and h=f and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close> and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
	]
	from assms(1,2,3,4) g h f f' g' h' f'' show ?thesis
	unfolding ABF_def BCG_def A_def B_def C_def
	by (intro cat_comma_is_arrI[OF assms(1,2)])
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
	)+
	qed


	subsubsection\<open>Identity\<close>

	lemma cat_comma_CId_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>)"
	unfolding cat_comma_components by simp

	lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	unfolding cat_comma_components'[OF assms(1,2)] by simp

	lemma cat_comma_CId_app[cat_comma_cs_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "A = [a, b ,f]\<^sub>\<circ>"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(4)[unfolded assms(3), unfolded cat_comma_components'[OF assms(1,2)]]
	have "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH>".
	then show ?thesis
	unfolding cat_comma_components'(6)[OF assms(1,2)] assms(3)
	by (simp add: nat_omega_simps)
	qed


	subsubsection\<open>\<open>Hom\<close>-set\<close>

	lemma cat_comma_Hom:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	shows "Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) A B = cat_comma_Hom \<GG> \<HH> A B"
	proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
	fix ABF assume "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	with assms(1,2) show "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	by (elim cat_comma_is_arrE[OF _ assms(1,2)], intro cat_comma_HomI) force+
	next
	fix ABF assume "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
	with assms(1,2) show "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	by (elim cat_comma_HomE[OF _ assms(1,2)], intro cat_comma_is_arrI) force+
	qed


	subsubsection\<open>Comma category is a category\<close>

	lemma category_cat_comma[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "category \<alpha> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
	proof-

	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))

	show ?thesis
	proof(rule categoryI')

	show "vfsequence (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)" unfolding cat_comma_def by auto
	show "vcard (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) = 6\<^sub>\<nat>"
	unfolding cat_comma_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by (rule cat_comma_Dom_vrange[OF assms])
	show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by (rule cat_comma_Cod_vrange[OF assms])
	show "(GF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
	(\<exists>g f b c a. GF = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b)"
	for GF
	proof(intro iffI; (elim exE conjE)?; (simp only: cat_comma_Comp_vdomain)?)
	assume prems: "GF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
	with assms obtain G F abf a'b'f' a''b''f''
	where "GF = [G, F]\<^sub>\<circ>"
	and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
	and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
	by auto
	with assms show "\<exists>g f b c a.
	GF = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b"
	by auto
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: cat_comma_composableI\<close>)
	from assms show "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	from assms show "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	for B C G A F
	using that by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from assms show
	"H \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F =
	H \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> (G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F)"
	if "H : C \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> D"
	and "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
	and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	for C D H B G A F
	using assms that
	proof-
	from that(3) assms obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with that(2) assms obtain a'' b'' f'' g' h'
	where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_cs_simps]:
	"f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto (slow)
	with that(1) assms obtain a''' b''' f''' g'' h''
	where H_def: "H = [[a'', b'', f'']\<^sub>\<circ>, [a''', b''', f''']\<^sub>\<circ>, [g'', h'']\<^sub>\<circ>]\<^sub>\<circ>"
	and D_def: "D = [a''', b''', f''']\<^sub>\<circ>"
	and g'': "g'' : a'' \<mapsto>\<^bsub>\<AA>\<^esub> a'''"
	and h'': "h'' : b'' \<mapsto>\<^bsub>\<BB>\<^esub> b'''"
	and f''': "f''' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'''\<rparr>"
	and [cat_cs_simps]:
	"f''' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g''\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h''\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	by auto (slow)
	note [cat_cs_simps] =
	category.cat_assoc_helper[
	where \<CC>=\<CC>
	and h=f''
	and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
	and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	category.cat_assoc_helper[
	where \<CC>=\<CC>
	and h=f''
	and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
	and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	category.cat_assoc_helper[
	where \<CC>=\<CC>
	and h=f'''
	and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g''\<rparr>\<close>
	and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h''\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''\<close>
	]
	from assms that g h f f' g' h' f'' g'' h'' f''' show ?thesis
	unfolding F_def G_def H_def A_def B_def C_def D_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed

	show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> A"
	if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
	using that
	by (elim cat_comma_ObjE[OF _ assms(1)]; (simp only:)?)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+

	show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F = F"
	if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
	using that
	by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+

	show "F \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>B\<rparr> = F"
	if "F : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" for B C F
	using that
	by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+

	show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI, elim cat_comma_ObjE[OF _ assms])
	fix F a b f assume prems:
	"F = [a, b, f]\<^sub>\<circ>"
	"a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	"b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	"f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	from prems(2-4) show "F \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros)
	qed

	show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	if "A \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "B \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	for A B
	proof-

	define A0 where "A0 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>0\<rparr>)"
	define A1 where "A1 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>1\<^sub>\<nat>\<rparr>)"
	define B0 where "B0 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>0\<rparr>)"
	define B1 where "B1 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>1\<^sub>\<nat>\<rparr>)"

	define A0B0 where "A0B0 = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A0. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B0. Hom \<AA> a b)"
	define A1B1 where "A1B1 = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A1. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B1. Hom \<BB> a b)"

	have A0B0: "A0B0 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding A0B0_def
	proof(rule \<GG>.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
	show "A0 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding A0_def
	proof(intro vrange_vprojection_in_VsetI that(3))
	fix F assume "F \<in>\<^sub>\<circ> A"
	with that(1) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
	with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
	show "vsv F" unfolding F_def by auto
	show "0 \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by simp
	qed auto
	show "B0 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding B0_def
	proof(intro vrange_vprojection_in_VsetI that(4))
	fix F assume "F \<in>\<^sub>\<circ> B"
	with that(2) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
	with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
	show "vsv F" unfolding F_def by auto
	show "0 \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by simp
	qed auto
	next
	fix a assume "a \<in>\<^sub>\<circ> A0"
	with that(1) obtain F
	where a_def: "a = F\<lparr>0\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	unfolding A0_def by force
	with assms obtain b f where "F = [a, b, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
	then show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding a_def by simp
	next
	fix a assume "a \<in>\<^sub>\<circ> B0"
	with that(2) obtain F
	where a_def: "a = F\<lparr>0\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	unfolding B0_def by force
	with assms obtain b f where "F = [a, b, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
	then show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding a_def by simp
	qed

	have A1B1: "A1B1 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding A1B1_def
	proof(rule \<FF>.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
	show "A1 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding A1_def
	proof(intro vrange_vprojection_in_VsetI that(3))
	fix F assume "F \<in>\<^sub>\<circ> A"
	with that(1) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
	with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
	show "vsv F" unfolding F_def by auto
	show "1\<^sub>\<nat> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by (simp add: nat_omega_simps)
	qed auto
	show "B1 \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding B1_def
	proof(intro vrange_vprojection_in_VsetI that(4))
	fix F assume "F \<in>\<^sub>\<circ> B"
	with that(2) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
	with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
	show "vsv F" unfolding F_def by auto
	show "1\<^sub>\<nat> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by (simp add: nat_omega_simps)
	qed auto
	next
	fix b assume "b \<in>\<^sub>\<circ> A1"
	with that(1) obtain F
	where b_def: "b = F\<lparr>1\<^sub>\<nat>\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	unfolding A1_def by force
	with assms obtain a f where "F = [a, b, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (auto simp: nat_omega_simps)
	then show "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding b_def by simp
	next
	fix b assume "b \<in>\<^sub>\<circ> B1"
	with that(2) obtain F
	where b_def: "b = F\<lparr>1\<^sub>\<nat>\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	unfolding B1_def by force
	with assms obtain a f where "F = [a, b, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (auto simp: nat_omega_simps)
	then show "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding b_def by simp
	qed

	define Q where
	"Q i = (if i = 0 then A else if i = 1\<^sub>\<nat> then B else (A0B0 \<times>\<^sub>\<bullet> A1B1))"
	for i
	have
	"(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B.
	Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof
	(
	intro vsubsetI,
	elim vifunionE,
	unfold in_Hom_iff,
	intro vproductI ballI
	)
	fix abf a'b'f' F assume prems:
	"abf \<in>\<^sub>\<circ> A" "a'b'f' \<in>\<^sub>\<circ> B" "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
	from prems(3) assms obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
	and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	have gh: "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> A0B0 \<times>\<^sub>\<bullet> A1B1"
	unfolding A0B0_def A1B1_def
	proof
	(
	intro ftimesI2 vifunionI,
	unfold in_Hom_iff A0_def B0_def A1_def B1_def
	)
	from prems(1) show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>0\<rparr>)"
	by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
	from prems(2) show "a' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>0\<rparr>)"
	by (intro vsv.vsv_vimageI2'[where a=a'b'f'])
	(simp_all add: a'b'f'_def)
	from prems(1) show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>1\<^sub>\<nat>\<rparr>)"
	by (intro vsv.vsv_vimageI2'[where a=abf])
	(simp_all add: nat_omega_simps abf_def)
	from prems(2) show "b' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>1\<^sub>\<nat>\<rparr>)"
	by (intro vsv.vsv_vimageI2'[where a=a'b'f'])
	(simp_all add: nat_omega_simps a'b'f'_def)
	qed (intro g h)+
	show "vsv F" unfolding F_def by auto
	show "\<D>\<^sub>\<circ> F = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	by (simp add: F_def three nat_omega_simps)
	fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	from this prems show "F\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
	by cases
	(simp_all add: F_def Q_def gh abf_def a'b'f'_def nat_omega_simps)
	qed
	moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule Limit_vproduct_in_VsetI)
	show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros)
	from A0B0 A1B1 assms(1,2) that(3,4) show
	"Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	for i
	by (simp_all add: Q_def Limit_ftimes_in_VsetI nat_omega_simps)
	qed auto
	ultimately show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed
	qed (auto simp: cat_comma_cs_simps intro: cat_comma_cs_intros)

	qed


	subsubsection\<open>Tiny comma category\<close>

	lemma tiny_category_cat_comma[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "tiny_category \<alpha> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
	proof-

	interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	note \<GG> = \<GG>.is_functor_axioms
	and \<HH> = \<HH>.is_functor_axioms
	interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

	show ?thesis
	proof(intro tiny_categoryI' category_cat_comma)
	have vrange_\<GG>: "\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vrange_in_VsetI \<GG>.tm_cf_ObjMap_in_Vset)
	moreover have vrange_\<HH>: "\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vrange_in_VsetI \<HH>.tm_cf_ObjMap_in_Vset)
	ultimately have UU_Hom_in_Vset:
	"(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	using \<GG>.cf_ObjMap_vrange \<HH>.cf_ObjMap_vrange
	by (auto intro: \<GG>.HomCod.cat_Hom_vifunion_in_Vset)
	define Q where
	"Q i =
	(
	if i = 0
	then \<AA>\<lparr>Obj\<rparr>
	else
	if i = 1\<^sub>\<nat>
	then \<BB>\<lparr>Obj\<rparr>
	else (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b)
	)"
	for i
	have "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro vsubsetI)
	fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	then obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (elim cat_comma_ObjE[OF _ \<GG> \<HH>])
	from f have f:
	"f \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b)"
	by (intro vifunionI, unfold in_Hom_iff)
	(
	simp_all add:
	a b
	\<HH>.ObjMap.vsv_vimageI2
	\<HH>.cf_ObjMap_vdomain
	\<GG>.ObjMap.vsv_vimageI2
	\<GG>.cf_ObjMap_vdomain
	)
	show "A \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	show "\<D>\<^sub>\<circ> A = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	unfolding A_def by (simp add: three nat_omega_simps)
	fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	from this a b f show "A\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
	unfolding A_def Q_def by cases (simp_all add: nat_omega_simps)
	qed (auto simp: A_def)
	qed
	moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule Limit_vproduct_in_VsetI)
	show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding three[symmetric] by simp
	from this show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	using that assms(1,2) UU_Hom_in_Vset
	by
	(
	simp_all add:
	Q_def
	\<GG>.HomDom.tiny_cat_Obj_in_Vset
	\<HH>.HomDom.tiny_cat_Obj_in_Vset
	nat_omega_simps
	)
	qed auto
	ultimately show [simp]: "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	define Q where
	"Q i =
	(
	if i = 0
	then \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>
	else
	if i = 1\<^sub>\<nat>
	then \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>
	else \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>
	)"
	for i
	have "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro vsubsetI)
	fix F assume "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain abf a'b'f' where F: "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
	by (auto intro: is_arrI)
	with assms obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
	and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	from g h have "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>" by auto
	show "F \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	show "\<D>\<^sub>\<circ> F = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	by (simp add: F_def three nat_omega_simps)
	fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	from this F g h show "F\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
	unfolding Q_def F_def abf_def[symmetric] a'b'f'_def[symmetric]
	by cases (auto simp: nat_omega_simps)
	qed (auto simp: F_def)
	qed
	moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule Limit_vproduct_in_VsetI)
	show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: three[symmetric] nat_omega_simps)
	moreover have "\<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	auto intro!:
	Limit_ftimes_in_VsetI
	\<GG>.\<Z>_\<beta> \<Z>_def
	\<GG>.HomDom.tiny_cat_Arr_in_Vset
	\<HH>.HomDom.tiny_cat_Arr_in_Vset
	)
	ultimately show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	using that assms(1,2) UU_Hom_in_Vset
	by
	(
	simp_all add:
	Q_def
	\<GG>.HomDom.tiny_cat_Obj_in_Vset
	\<HH>.HomDom.tiny_cat_Obj_in_Vset
	nat_omega_simps
	)
	qed auto
	ultimately show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed (rule \<GG>, rule \<HH>)

	qed



	subsection\<open>Opposite comma category functor\<close>


	subsubsection\<open>Background\<close>


	text\<open>
	See \cite{noauthor_wikipedia_2001}\footnote{
	\url{https://en.wikipedia.org/wiki/Opposite_category}
	} for background information.
	\<close>


	subsubsection\<open>Object flip\<close>

	definition op_cf_commma_obj_flip :: "V \<Rightarrow> V \<Rightarrow> V"
	where "op_cf_commma_obj_flip \<GG> \<HH> =
	(\<lambda>A\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>. [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>0\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"


	text\<open>Elementary properties.\<close>

	mk_VLambda op_cf_commma_obj_flip_def
	\|vsv op_cf_commma_obj_flip_vsv[cat_comma_cs_intros]\|
	\|vdomain op_cf_commma_obj_flip_vdomain[cat_comma_cs_simps]\|
	\|app op_cf_commma_obj_flip_app'\|

	lemma op_cf_commma_obj_flip_app[cat_comma_cs_simps]:
	assumes "A = [a, b, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
	shows "op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> = [b, a, f]\<^sub>\<circ>"
	using assms unfolding op_cf_commma_obj_flip_def by (simp add: nat_omega_simps)

	lemma op_cf_commma_obj_flip_v11[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "v11 (op_cf_commma_obj_flip \<GG> \<HH>)"
	proof(rule vsv.vsv_valeq_v11I, unfold op_cf_commma_obj_flip_vdomain)
	fix A B assume prems:
	"A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	"B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	"op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr>"
	from prems(1,2) assms obtain a b f a' b' f'
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	by (elim cat_comma_ObjE[OF _ assms])
	from prems(3,1,2) show "A = B"
	by (simp_all add: A_def B_def op_cf_commma_obj_flip_app nat_omega_simps)
	qed (auto intro: op_cf_commma_obj_flip_vsv)

	lemma op_cf_commma_obj_flip_vrange[cat_comma_cs_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
	proof(intro vsubset_antisym)
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	show "\<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>) \<subseteq>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset op_cf_commma_obj_flip_vsv,
	unfold cat_comma_cs_simps
	)
	fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	then obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (elim cat_comma_ObjE[OF _ assms])
	from a b f show
	"op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	show "(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
	proof(intro vsubsetI)
	fix B assume "B \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
	then obtain a b f
	where B_def: "B = [b, a, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	elim cat_comma_ObjE[
	OF _ \<HH>.is_functor_op \<GG>.is_functor_op, unfolded cat_op_simps
	]
	)
	from a b f have B_def: "B = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a, b, f\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps B_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from a b f have "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	with op_cf_commma_obj_flip_vsv show "B \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
	unfolding B_def by auto
	qed
	qed


	subsubsection\<open>Definition and elementary properties\<close>

	definition op_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V"
	where "op_cf_comma \<GG> \<HH> =
	[
	op_cf_commma_obj_flip \<GG> \<HH>,
	(
	\<lambda>ABF\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Arr\<rparr>.
	[
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>,
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>0\<rparr>\<rparr>,
	[ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>
	]\<^sub>\<circ>
	),
	op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>),
	(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_cf_comma_components:
	shows [cat_comma_cs_simps]:
	"op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr> = op_cf_commma_obj_flip \<GG> \<HH>"
	and "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>ABF\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Arr\<rparr>.
	[
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>,
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>0\<rparr>\<rparr>,
	[ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>
	]\<^sub>\<circ>
	)"
	and [cat_comma_cs_simps]:
	"op_cf_comma \<GG> \<HH>\<lparr>HomDom\<rparr> = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
	and [cat_comma_cs_simps]:
	"op_cf_comma \<GG> \<HH>\<lparr>HomCod\<rparr> = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
	unfolding op_cf_comma_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow map\<close>

	mk_VLambda op_cf_comma_components(2)
	\|vsv op_cf_comma_ArrMap_vsv[cat_comma_cs_intros]\|
	\|vdomain op_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]\|
	\|app op_cf_comma_ArrMap_app'\|

	lemma op_cf_comma_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
	[
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>,
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a, b, f\<rparr>\<^sub>\<bullet>,
	[h, g]\<^sub>\<circ>
	]\<^sub>\<circ>"
	using assms(2) by (simp add: assms(1) op_cf_comma_ArrMap_app' nat_omega_simps)

	lemma op_cf_comma_ArrMap_v11[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "v11 (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
	proof
	(
	rule vsv.vsv_valeq_v11I,
	unfold op_cf_comma_ArrMap_vdomain,
	intro op_cf_comma_ArrMap_vsv
	)
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	fix ABF ABF' assume prems:
	"ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	"ABF' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	"op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF'\<rparr>"
	from prems(1) obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	from prems(2) obtain A' B' where ABF': "ABF' : A' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B'" by auto
	from ABF obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (elim cat_comma_is_arrE[OF _ assms])
	from ABF' obtain a'' b'' f'' a''' b''' f''' g' h'
	where ABF'_def: "ABF' = [[a'', b'', f'']\<^sub>\<circ>, [a''', b''', f''']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A'_def: "A' = [a'', b'', f'']\<^sub>\<circ>"
	and B'_def: "B' = [a''', b''', f''']\<^sub>\<circ>"
	and "g' : a'' \<mapsto>\<^bsub>\<AA>\<^esub> a'''"
	and "h' : b'' \<mapsto>\<^bsub>\<BB>\<^esub> b'''"
	and "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and "f''' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'''\<rparr>"
	and "f''' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	by (elim cat_comma_is_arrE[OF _ assms])
	from ABF ABF' have abf:
	"[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
	"[a', b', f']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
	"[a'', b'', f'']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
	"[a''', b''', f''']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
	unfolding ABF_def ABF'_def A_def B_def A'_def B'_def by auto
	note v11_injective = v11.v11_injective[
	OF op_cf_commma_obj_flip_v11, OF assms, unfolded cat_comma_cs_simps
	]
	from
	prems(3,1,2) assms
	op_cf_commma_obj_flip_v11
	v11_injective[OF abf(1,3)]
	v11_injective[OF abf(2,4)]
	show "ABF = ABF'"
	by
	(
	simp_all add:
	ABF_def ABF'_def op_cf_comma_ArrMap_app' nat_omega_simps
	)
	qed

	lemma op_cf_comma_ArrMap_is_arr:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> :
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr> \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub>
	op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms(3) obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'g_hf: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (elim cat_comma_is_arrE[OF _ assms(1,2)])
	from g h f f' f'g_hf show ?thesis
	unfolding ABF_def A_def B_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed

	lemma op_cf_comma_ArrMap_is_arr':
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
	and "A' = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr>"
	and "B' = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr>"
	shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> : A' \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub> B'"
	using assms(1-3) unfolding assms(4,5) by (intro op_cf_comma_ArrMap_is_arr)

	lemma op_cf_comma_ArrMap_vrange[cat_comma_cs_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	interpret op_\<GG>\<HH>: category \<alpha> \<open>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros cat_op_intros)
	show ?thesis
	proof(intro vsubset_antisym)
	show "\<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset op_cf_comma_ArrMap_vsv,
	unfold cat_comma_cs_simps
	)
	fix ABF assume prems: "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	from op_cf_comma_ArrMap_is_arr[OF assms this] show
	"op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
	by auto
	qed
	show "(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
	proof(intro vsubsetI)
	fix ABF assume prems: "ABF \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
	then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub> B"
	by auto
	then obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a' \<mapsto>\<^bsub>\<BB>\<^esub> a"
	and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and f'g_hf: "f' \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> \<HH>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f"
	by
	(
	elim cat_comma_is_arrE[
	OF _ \<HH>.is_functor_op \<GG>.is_functor_op, unfolded cat_op_simps
	]
	)
	from f'g_hf g h f f' have gf'_fh:
	"\<HH>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	)
	with g h f f' have
	"[[b', a', f']\<^sub>\<circ>, [b, a, f]\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
	"ABF = op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>[b', a', f']\<^sub>\<circ>, [b, a, f]\<^sub>\<circ>, [h, g]\<^sub>\<circ>\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps ABF_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+
	with op_cf_comma_ArrMap_vsv show "ABF \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
	by auto
	qed
	qed
	qed


	subsubsection\<open>Opposite comma category functor is an isomorphism of categories\<close>

	lemma op_cf_comma_is_iso_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "op_cf_comma \<GG> \<HH> :
	op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	show ?thesis
	proof(intro is_iso_functorI' is_functorI')
	show "vfsequence (op_cf_comma \<GG> \<HH>)"
	unfolding op_cf_comma_def by simp
	show "vcard (op_cf_comma \<GG> \<HH>) = 4\<^sub>\<nat>"
	unfolding op_cf_comma_def by (simp add: nat_omega_simps)
	from assms show "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> :
	op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub>
	op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "ABF : A \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> B" for A B ABF
	using that
	unfolding cat_op_simps
	by
	(
	cs_concl cs_shallow
	cs_intro: op_cf_comma_ArrMap_is_arr' cs_simp: cat_comma_cs_simps
	)
	show
	"op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> F\<rparr> =
	op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub>
	op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> C"
	and "F : A \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> B"
	for B C G A F
	proof-
	note G = that(1)[unfolded cat_op_simps]
	note F = that(2)[unfolded cat_op_simps]
	from assms G obtain a b f a' b' f' g h
	where G_def: "G = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [symmetric, cat_comma_cs_simps]:
	"f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with assms F obtain a'' b'' f'' g' h'
	where F_def: "F = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a'', b'', f'']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_comma_cs_simps]:
	"f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto (slow)
	note [cat_comma_cs_simps] =
	category.cat_assoc_helper[
	where \<CC>=\<CC> and h=f'' and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	from assms that g h f f' g' h' f' f'' show ?thesis
	unfolding cat_op_simps G_def C_def B_def F_def A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	show
	"op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
	(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>CId\<rparr>\<lparr>op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>" for C
	proof-
	from that[unfolded cat_op_simps] assms obtain a b f
	where C_def: "C = [a, b, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from a b f that show ?thesis
	unfolding cat_op_simps C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_op_intros
	)+
	qed

	lemma op_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
	and "\<BB>' = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
	shows "op_cf_comma \<GG> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_iso_functor)

	lemma op_cf_comma_is_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "op_cf_comma \<GG> \<HH> :
	op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
	by (rule is_iso_functorD(1)[OF op_cf_comma_is_iso_functor[OF assms]])

	lemma op_cf_comma_is_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
	and "\<BB>' = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
	shows "op_cf_comma \<GG> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_functor)



	subsection\<open>Projections for a comma category\<close>


	subsubsection\<open>Definitions and elementary properties\<close>


	text\<open>See Chapter II-6 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_comma_proj_left :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<Sqinter> _)\<close> [1000, 1000] 999)
	where "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>0\<rparr>),
	(\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>),
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>,
	\<GG>\<lparr>HomDom\<rparr>
	]\<^sub>\<circ>"

	definition cf_comma_proj_right :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<Sqinter>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
	where "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>),
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>,
	\<HH>\<lparr>HomDom\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_comma_proj_left_components:
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>0\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>)"
	and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>HomDom\<rparr> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomDom\<rparr>"
	unfolding cf_comma_proj_left_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	lemma cf_comma_proj_right_components:
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>HomDom\<rparr> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>HomCod\<rparr> = \<HH>\<lparr>HomDom\<rparr>"
	unfolding cf_comma_proj_right_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<GG> \<HH>
	assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<HH>: "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule \<GG>)
	interpretation \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule \<HH>)

	lemmas cf_comma_proj_left_components' =
	cf_comma_proj_left_components[of \<GG> \<HH>, unfolded \<GG>.cf_HomDom]

	lemmas cf_comma_proj_right_components' =
	cf_comma_proj_right_components[of \<GG> \<HH>, unfolded \<HH>.cf_HomDom]

	lemmas [cat_comma_cs_simps] =
	cf_comma_proj_left_components'(3,4)
	cf_comma_proj_right_components'(3,4)

	end


	subsubsection\<open>Object map\<close>

	mk_VLambda cf_comma_proj_left_components(1)
	\|vsv cf_comma_proj_left_ObjMap_vsv[cat_comma_cs_intros]\|
	\|vdomain cf_comma_proj_left_ObjMap_vdomain[cat_comma_cs_simps]\|

	mk_VLambda cf_comma_proj_right_components(1)
	\|vsv cf_comma_proj_right_ObjMap_vsv[cat_comma_cs_intros]\|
	\|vdomain cf_comma_proj_right_ObjMap_vdomain[cat_comma_cs_simps]\|

	lemma cf_comma_proj_left_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
	using assms(2) unfolding assms(1) cf_comma_proj_left_components by simp

	lemma cf_comma_proj_right_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = b"
	using assms(2)
	unfolding assms(1) cf_comma_proj_right_components
	by (simp add: nat_omega_simps)

	lemma cf_comma_proj_left_ObjMap_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
	fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	with assms obtain a b f where A_def: "A = [a, b, f]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by auto
	from assms prems a show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding A_def by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	qed (auto intro: cat_comma_cs_intros)

	lemma cf_comma_proj_right_ObjMap_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
	fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	with assms obtain a b f where A_def: "A = [a, b, f]\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by auto
	from assms prems b show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	unfolding A_def by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	qed (auto intro: cat_comma_cs_intros)


	subsubsection\<open>Arrow map\<close>

	mk_VLambda cf_comma_proj_left_components(2)
	\|vsv cf_comma_proj_left_ArrMap_vsv[cat_comma_cs_intros]\|
	\|vdomain cf_comma_proj_left_ArrMap_vdomain[cat_comma_cs_simps]\|

	mk_VLambda cf_comma_proj_right_components(2)
	\|vsv cf_comma_proj_right_ArrMap_vsv[cat_comma_cs_intros]\|
	\|vdomain cf_comma_proj_right_ArrMap_vdomain[cat_comma_cs_simps]\|

	lemma cf_comma_proj_left_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>" and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = g"
	using assms(2)
	unfolding assms(1) cf_comma_proj_left_components
	by (simp add: nat_omega_simps)

	lemma cf_comma_proj_right_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = h"
	using assms(2)
	unfolding assms(1) cf_comma_proj_right_components
	by (simp add: nat_omega_simps)

	lemma cf_comma_proj_left_ArrMap_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
	from assms interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain A B where "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	with assms obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	by auto
	from assms prems g show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	unfolding F_def
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	qed (auto intro: cat_comma_cs_intros)

	lemma cf_comma_proj_right_ArrMap_vrange:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
	from assms interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	with assms obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	by auto
	from assms prems h show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	unfolding F_def
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	qed (auto intro: cat_comma_cs_intros)


	subsubsection\<open>Projections for a comma category are functors\<close>

	lemma cf_comma_proj_left_is_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	from assms interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	show ?thesis
	proof(rule is_functorI')
	show "vfsequence (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)"
	unfolding cf_comma_proj_left_def by auto
	show "vcard (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = 4\<^sub>\<nat>"
	unfolding cf_comma_proj_left_def by (simp add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (rule cf_comma_proj_left_ObjMap_vrange)
	show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
	proof-
	from assms that obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	by auto
	from that g show
	"\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	unfolding F_def A_def B_def
	by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	qed
	show
	"\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F\<rparr> =
	\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for B C G A F
	proof-
	from assms that(2) obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with that(1) assms obtain a'' b'' f'' g' h'
	where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto (slow)
	note [cat_cs_simps] =
	category.cat_assoc_helper
	[
	where \<CC>=\<CC>
	and h=f''
	and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
	and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	category.cat_assoc_helper
	[
	where \<CC>=\<CC>
	and h=f
	and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close>
	and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
	]
	from assms that g g' h h' f f' f'' show ?thesis
	unfolding F_def G_def A_def B_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	qed
	show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>\<rparr>"
	if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
	proof-
	from assms that obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from assms that this(2-4) show ?thesis
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	qed
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	\<close>
	)+
	qed

	lemma cf_comma_proj_left_is_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_functor)

	lemma cf_comma_proj_right_is_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	from assms interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	show ?thesis
	proof(rule is_functorI')
	show "vfsequence (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)"
	unfolding cf_comma_proj_right_def by auto
	show "vcard (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = 4\<^sub>\<nat>"
	unfolding cf_comma_proj_right_def by (simp add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (rule cf_comma_proj_right_ObjMap_vrange)
	show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
	proof-
	from assms that obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	by auto
	from that h show
	"\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	unfolding F_def A_def B_def
	by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	qed
	show
	"\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F\<rparr> =
	\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for B C G A F
	proof-
	from assms that(2) obtain a b f a' b' f' g h
	where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	with that(1) assms obtain a'' b'' f'' g' h'
	where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
	and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	by auto (slow)
	note [cat_cs_simps] =
	category.cat_assoc_helper
	[
	where \<CC>=\<CC>
	and h=f''
	and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
	and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
	]
	category.cat_assoc_helper
	[
	where \<CC>=\<CC>
	and h=f
	and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close>
	and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
	]
	from assms that g g' h h' f f' f'' show ?thesis
	unfolding F_def G_def A_def B_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	qed
	show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>\<rparr>"
	if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
	proof-
	from assms that obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from assms that this(2-4) show ?thesis
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	qed
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	\<close>
	)+
	qed

	lemma cf_comma_proj_right_is_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_functor)


	subsubsection\<open>Opposite projections for a comma category\<close>

	lemma op_cf_comma_proj_left:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = (op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = (op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
	proof(rule cf_eqI)
	show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) : op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_op_simps)+
	show "(op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH> :
	op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
	then have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>) =
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>) =
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
	show
	"op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr> =
	((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	with assms obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from a b f show
	"op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)+
	show
	"op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr> =
	- ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
	+ ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix ABF assume "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain A B where "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	with assms obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [symmetric, cat_cs_simps]:
	"f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	from g h f f' show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
	((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr>"
	unfolding ABF_def A_def B_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)+
	qed simp_all
	qed

	lemma op_cf_comma_proj_right:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
	proof(rule cf_eqI)
	show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) : op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_op_simps)+
	show "(op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH> :
	op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
	then have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>) =
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	and ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>) =
	\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
	show
	"op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr> =
	((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	with assms obtain a b f
	where A_def: "A = [a, b, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from a b f show
	"op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)+
	show
	"op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr> =
	- ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
	+ ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix ABF assume prems: "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	with assms obtain a b f a' b' f' g h
	where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b, f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and [symmetric, cat_cs_simps]:
	"f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by auto
	from g h f f' show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
	((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr>"
	unfolding ABF_def A_def B_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)+
	qed simp_all
	qed


	subsubsection\<open>Projections for a tiny comma category\<close>

	lemma cf_comma_proj_left_is_tm_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_tm_functorI')

	interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))

	show \<Pi>_\<GG>\<HH>: "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

	interpret \<Pi>_\<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<AA> \<open>\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<close>
	by (rule \<Pi>_\<GG>\<HH>)
	interpret \<GG>\<HH>: tiny_category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_comma_cs_intros)

	show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note \<Pi>_\<GG>\<HH>.cf_ObjMap_vrange
	moreover have "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
	ultimately show ?thesis by auto
	qed
	qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

	show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note \<Pi>_\<GG>\<HH>.cf_ArrMap_vrange
	moreover have "\<AA>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
	ultimately show ?thesis by auto
	qed
	qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

	qed

	lemma cf_comma_proj_left_is_tm_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG>\<HH> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG>\<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_tm_functor)

	lemma cf_comma_proj_right_is_tm_functor:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(intro is_tm_functorI')

	interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))

	show \<Pi>_\<GG>\<HH>: "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

	interpret \<Pi>_\<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<BB> \<open>\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<close>
	by (rule \<Pi>_\<GG>\<HH>)
	interpret \<GG>\<HH>: tiny_category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_comma_cs_intros)

	show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note \<Pi>_\<GG>\<HH>.cf_ObjMap_vrange
	moreover have "\<BB>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
	ultimately show ?thesis by auto
	qed
	qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

	show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note \<Pi>_\<GG>\<HH>.cf_ArrMap_vrange
	moreover have "\<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
	ultimately show ?thesis by auto
	qed
	qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

	qed

	lemma cf_comma_proj_right_is_tm_functor'[cat_comma_cs_intros]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG>\<HH> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG>\<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_tm_functor)


	+lemma cf_comp_cf_comma_proj_left_is_tm_functor[cat_comma_cs_intros]:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	+ shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	+proof(intro is_tm_functorI')
	+
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	+ interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<FF> by (rule assms(3))
	+ interpret \<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<AA> \<open>\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<close>
	+ by (rule cf_comma_proj_left_is_functor[OF assms(1-2)])
	+
	+ show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	+
	+ show "(\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding dghm_comp_components
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "vbrelation (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>)" by auto
	+ show "Limit \<alpha>" by auto
	+ show "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro: \<FF>.cf_ObjMap_vrange cat_small_cs_intros
	+ )
	+ show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vrange_vcomp
	+ proof-
	+ have "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))))"
	+ proof(intro vsubsetI)
	+ fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ then obtain abf
	+ where abf_in_\<FF>: "abf \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ and \<GG>\<HH>_abf: "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>abf\<rparr> = A"
	+ by auto
	+ with \<FF>.ObjMap.vrange_atD obtain j
	+ where "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and \<FF>j: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = abf"
	+ by (force simp: \<FF>.cf_ObjMap_vdomain)
	+ from abf_in_\<FF> \<FF>.cf_ObjMap_vrange have abf_in_\<GG>\<HH>:
	+ "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	+ by auto
	+ then obtain a b f where abf_def: "abf = [a, b, f]\<^sub>\<circ>"
	+ by (elim cat_comma_ObjE[OF _ assms(1,2)])
	+ have "a \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))))"
	+ proof(intro VUnionI)
	+ from abf_in_\<FF> show "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ unfolding abf_def by auto
	+ show "\<langle>0, a\<rangle> \<in>\<^sub>\<circ> [a, b, f]\<^sub>\<circ>" by auto
	+ show "set {0, a} \<in>\<^sub>\<circ> \<langle>0, a\<rangle>" unfolding vpair_def by simp
	+ qed auto
	+ with abf_in_\<GG>\<HH> show "A \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ>(\<FF>\<lparr>ObjMap\<rparr>))))"
	+ unfolding \<GG>\<HH>_abf[symmetric] abf_def
	+ by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	+ qed
	+ moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro VUnion_in_VsetI vrange_in_VsetI[OF \<FF>.tm_cf_ObjMap_in_Vset])
	+ ultimately show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ qed
	+ qed
	+
	+ show "(\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding dghm_comp_components
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "vbrelation (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>)" by auto
	+ show "Limit \<alpha>" by auto
	+ show "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro: \<FF>.cf_ArrMap_vrange cat_small_cs_intros
	+ )
	+ show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vrange_vcomp
	+ proof-
	+ have
	+ "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ>
	+ \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ proof(intro vsubsetI)
	+ fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ then obtain ABF
	+ where ABF_in_\<FF>: "ABF \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ and \<GG>\<HH>_ABF: "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = F"
	+ by auto
	+ with \<FF>.ArrMap.vrange_atD obtain k
	+ where "k \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" and \<FF>j: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = ABF"
	+ by (force simp: \<FF>.cf_ArrMap_vdomain)
	+ then obtain i j where "k : i \<mapsto>\<^bsub>\<JJ>\<^esub> j" by auto
	+ from ABF_in_\<FF> \<FF>.cf_ArrMap_vrange have ABF_in_\<GG>\<HH>:
	+ "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	+ by auto
	+ then obtain A B where "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	+ with assms obtain a b f a' b' f' g h
	+ where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	+ by (elim cat_comma_is_arrE[OF _ assms(1,2)])
	+ have "g \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ proof(intro VUnionI)
	+ from ABF_in_\<FF> show
	+ "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ unfolding ABF_def by auto
	+ show "\<langle>2\<^sub>\<nat>, [g, h]\<^sub>\<circ>\<rangle> \<in>\<^sub>\<circ> [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	+ by (auto simp: nat_omega_simps)
	+ show "set {2\<^sub>\<nat>, [g, h]\<^sub>\<circ>} \<in>\<^sub>\<circ> \<langle>2\<^sub>\<nat>, [g, h]\<^sub>\<circ>\<rangle>"
	+ unfolding vpair_def by auto
	+ show "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> set {2\<^sub>\<nat>, [g, h]\<^sub>\<circ>}" by simp
	+ show "\<langle>0, g\<rangle> \<in>\<^sub>\<circ> [g, h]\<^sub>\<circ>" by auto
	+ show "set {0, g} \<in>\<^sub>\<circ> \<langle>0, g\<rangle>" unfolding vpair_def by auto
	+ qed auto
	+ with ABF_in_\<GG>\<HH> show "F \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ unfolding \<GG>\<HH>_ABF[symmetric] ABF_def
	+ by (cs_concl cs_simp: cat_cs_simps cat_comma_cs_simps)
	+ qed
	+ moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>))))))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro VUnion_in_VsetI vrange_in_VsetI[OF \<FF>.tm_cf_ArrMap_in_Vset])
	+ ultimately show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ qed
	+ qed
	+
	+qed
	+
	+lemma cf_comp_cf_comma_proj_right_is_tm_functor[cat_comma_cs_intros]:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
	+ shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof(intro is_tm_functorI')
	+
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	+ interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<FF> by (rule assms(3))
	+ interpret \<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<BB> \<open>\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<close>
	+ by (rule cf_comma_proj_right_is_functor[OF assms(1-2)])
	+
	+ show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	+
	+ show "(\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding dghm_comp_components
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "vbrelation (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>)" by auto
	+ show "Limit \<alpha>" by auto
	+ show "\<D>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro: \<FF>.cf_ObjMap_vrange cat_small_cs_intros
	+ )
	+ show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vrange_vcomp
	+ proof-
	+ have "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))))"
	+ proof(intro vsubsetI)
	+ fix A assume prems: "A \<in>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ then obtain abf
	+ where abf_in_\<FF>: "abf \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ and \<GG>\<HH>_abf: "(\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>\<lparr>abf\<rparr> = A"
	+ by (auto simp: cf_comma_proj_right_ObjMap_vsv)
	+ with \<FF>.ObjMap.vrange_atD obtain j
	+ where "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and \<FF>j: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = abf"
	+ by (force simp: \<FF>.cf_ObjMap_vdomain)
	+ from abf_in_\<FF> \<FF>.cf_ObjMap_vrange have abf_in_\<GG>\<HH>:
	+ "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
	+ by auto
	+ then obtain a b f where abf_def: "abf = [a, b, f]\<^sub>\<circ>"
	+ by (elim cat_comma_ObjE[OF _ assms(1,2)])
	+ have "b \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>))))"
	+ proof(intro VUnionI)
	+ from abf_in_\<FF> show "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ unfolding abf_def by auto
	+ show "\<langle>1\<^sub>\<nat>, b\<rangle> \<in>\<^sub>\<circ> [a, b, f]\<^sub>\<circ>" by (auto simp: nat_omega_simps)
	+ show "set {1\<^sub>\<nat>, b} \<in>\<^sub>\<circ> \<langle>1\<^sub>\<nat>, b\<rangle>" unfolding vpair_def by simp
	+ qed auto
	+ with abf_in_\<GG>\<HH> show "A \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ>(\<FF>\<lparr>ObjMap\<rparr>))))"
	+ unfolding \<GG>\<HH>_abf[symmetric] abf_def
	+ by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	+ qed
	+ moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro VUnion_in_VsetI vrange_in_VsetI[OF \<FF>.tm_cf_ObjMap_in_Vset])
	+ ultimately show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ qed
	+ qed
	+
	+ show "(\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding dghm_comp_components
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "vbrelation (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>)" by auto
	+ show "Limit \<alpha>" by auto
	+ show "\<D>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro: \<FF>.cf_ArrMap_vrange cat_small_cs_intros
	+ )
	+ show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vrange_vcomp
	+ proof-
	+ have
	+ "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ>
	+ \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ proof(intro vsubsetI)
	+ fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ then obtain ABF
	+ where ABF_in_\<FF>: "ABF \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ and \<GG>\<HH>_ABF: "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = F"
	+ by (auto simp: cf_comma_proj_right_ArrMap_vsv)
	+ with \<FF>.ArrMap.vrange_atD obtain k
	+ where "k \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" and \<FF>j: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = ABF"
	+ by (force simp: \<FF>.cf_ArrMap_vdomain)
	+ then obtain i j where "k : i \<mapsto>\<^bsub>\<JJ>\<^esub> j" by auto
	+ from ABF_in_\<FF> \<FF>.cf_ArrMap_vrange have ABF_in_\<GG>\<HH>:
	+ "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
	+ by auto
	+ then obtain A B where "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
	+ with assms obtain a b f a' b' f' g h
	+ where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	+ by (elim cat_comma_is_arrE[OF _ assms(1,2)])
	+ have "h \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ proof(intro VUnionI)
	+ from ABF_in_\<FF> show
	+ "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ unfolding ABF_def by auto
	+ show "\<langle>2\<^sub>\<nat>, [g, h]\<^sub>\<circ>\<rangle> \<in>\<^sub>\<circ> [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	+ by (auto simp: nat_omega_simps)
	+ show "set {2\<^sub>\<nat>, [g, h]\<^sub>\<circ>} \<in>\<^sub>\<circ> \<langle>2\<^sub>\<nat>, [g, h]\<^sub>\<circ>\<rangle>"
	+ unfolding vpair_def by auto
	+ show "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> set {2\<^sub>\<nat>, [g, h]\<^sub>\<circ>}" by simp
	+ show "\<langle>1\<^sub>\<nat>, h\<rangle> \<in>\<^sub>\<circ> [g, h]\<^sub>\<circ>" by (auto simp: nat_omega_simps)
	+ show "set {1\<^sub>\<nat>, h} \<in>\<^sub>\<circ> \<langle>1\<^sub>\<nat>, h\<rangle>" unfolding vpair_def by auto
	+ qed auto
	+ with ABF_in_\<GG>\<HH> show "F \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)))))))"
	+ unfolding \<GG>\<HH>_ABF[symmetric] ABF_def
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_comma_cs_simps)
	+ qed
	+ moreover have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>))))))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro VUnion_in_VsetI vrange_in_VsetI[OF \<FF>.tm_cf_ArrMap_in_Vset])
	+ ultimately show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ qed
	+ qed
	+
	+qed
	+
	+

	subsection\<open>Comma categories constructed from a functor and an object\<close>


	subsubsection\<open>Definitions and elementary properties\<close>


	text\<open>See Chapter II-6 in \cite{mac_lane_categories_2010}.\<close>

	definition cat_cf_obj_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<down> _)\<close> [1000, 1000] 999)
	where "\<FF> \<^sub>C\<^sub>F\<down> b \<equiv> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"

	definition cat_obj_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
	where "b \<down>\<^sub>C\<^sub>F \<FF> \<equiv> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>"


	text\<open>Alternative forms of the definitions.\<close>

	lemma (in is_functor) cat_cf_obj_comma_def:
	"\<FF> \<^sub>C\<^sub>F\<down> b = \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)"
	unfolding cat_cf_obj_comma_def cf_HomCod ..

	lemma (in is_functor) cat_obj_cf_comma_def:
	"b \<down>\<^sub>C\<^sub>F \<FF> = (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>"
	unfolding cat_obj_cf_comma_def cf_HomCod ..


	+text\<open>Size.\<close>
	+
	+lemma small_cat_cf_obj_comma_Obj[simp]:
	+ "small {[a, 0, f]\<^sub>\<circ> \| a f. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<and> f : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>}"
	+ (is \<open>small ?afs\<close>)
	+proof-
	+ define Q where
	+ "Q i = (if i = 0 then \<AA>\<lparr>Obj\<rparr> else if i = 1\<^sub>\<nat> then set {0} else \<CC>\<lparr>Arr\<rparr>)"
	+ for i
	+ have "?afs \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ unfolding Q_def
	+ proof
	+ (
	+ intro subsetI,
	+ unfold mem_Collect_eq,
	+ elim exE conjE,
	+ intro vproductI;
	+ simp only:
	+ )
	+ fix a f show "\<D>\<^sub>\<circ> [a, 0, f]\<^sub>\<circ> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	+ by (simp add: three nat_omega_simps)
	+ qed (force simp: nat_omega_simps)+
	+ then show "small ?afs" by (rule down)
	+qed
	+
	+lemma small_cat_obj_cf_comma_Obj[simp]:
	+ "small {[0, b, f]\<^sub>\<circ> \| b f. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<and> f : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>}"
	+ (is \<open>small ?bfs\<close>)
	+proof-
	+ define Q where
	+ "Q i = (if i = 0 then set {0} else if i = 1\<^sub>\<nat> then \<BB>\<lparr>Obj\<rparr> else \<CC>\<lparr>Arr\<rparr>)"
	+ for i
	+ have "?bfs \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ unfolding Q_def
	+ proof
	+ (
	+ intro subsetI,
	+ unfold mem_Collect_eq,
	+ elim exE conjE,
	+ intro vproductI;
	+ simp only:
	+ )
	+ fix a b f show "\<D>\<^sub>\<circ> [0, b, f]\<^sub>\<circ> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	+ by (simp add: three nat_omega_simps)
	+ qed (force simp: nat_omega_simps)+
	+ then show "small ?bfs" by (rule down)
	+qed
	+
	+
	+
	subsubsection\<open>Objects\<close>

	lemma (in is_functor) cat_cf_obj_comma_ObjI[cat_comma_cs_intros]:
	assumes "A = [a, 0, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	using assms(2,3)
	unfolding assms(1)
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_cf_obj_comma_def
	cs_intro: cat_cs_intros vempty_is_zet cat_comma_ObjI
	)

	lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ObjI

	lemma (in is_functor) cat_obj_cf_comma_ObjI[cat_comma_cs_intros]:
	assumes "A = [0, a, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	shows "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	using assms(2,3)
	unfolding assms(1)
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_obj_cf_comma_def
	cs_intro: vempty_is_zet cat_cs_intros cat_comma_ObjI
	)

	lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ObjI

	lemma (in is_functor) cat_cf_obj_comma_ObjD[dest]:
	assumes "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b' = 0" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	proof-
	from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	note obj = cat_comma_ObjD[
	OF assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
	]
	from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
	moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	ultimately show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b' = 0" "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	using obj by auto
	qed

	lemmas [dest] = is_functor.cat_cf_obj_comma_ObjD[rotated 1]

	lemma (in is_functor) cat_obj_cf_comma_ObjD[dest]:
	assumes "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b' = 0" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	proof-
	from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	note obj = cat_comma_ObjD[
	OF assms(1)[unfolded cat_obj_cf_comma_def] this is_functor_axioms
	]
	from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
	moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	ultimately show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b' = 0" "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	using obj by auto
	qed

	lemmas [dest] = is_functor.cat_obj_cf_comma_ObjD[rotated 1]

	lemma (in is_functor) cat_cf_obj_comma_ObjE[elim]:
	assumes "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains a f
	where "A = [a, 0, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	proof-
	from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
	obtain a b' f
	where "A = [a, b', f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> cat_1 0 0\<lparr>Obj\<rparr>"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	moreover from b' have [cat_cs_simps]: "b' = 0"
	unfolding cat_1_components by auto
	moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	ultimately show ?thesis using that by auto
	qed

	lemmas [elim] = is_functor.cat_cf_obj_comma_ObjE[rotated 1]

	lemma (in is_functor) cat_obj_cf_comma_ObjE[elim]:
	assumes "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains a f
	where "A = [0, a, f]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	proof-
	from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(1)[unfolded cat_obj_cf_comma_def] is_functor_axioms this
	obtain a b' f
	where A_def: "A = [b', a, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> cat_1 0 0\<lparr>Obj\<rparr>"
	and f: "f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by auto
	moreover from b' have [cat_cs_simps]: "b' = 0"
	unfolding cat_1_components by auto
	moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	ultimately show ?thesis using that by auto
	qed

	lemmas [elim] = is_functor.cat_obj_cf_comma_ObjE[rotated 1]


	subsubsection\<open>Arrows\<close>

	lemma (in is_functor) cat_cf_obj_comma_ArrI[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, 0, f]\<^sub>\<circ>"
	and "B = [a', 0, f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	shows "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	unfolding cat_cf_obj_comma_def
	proof(intro cat_comma_ArrI cat_comma_HomI)
	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(1) show const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from vempty_is_zet show 0: "0 : 0 \<mapsto>\<^bsub>cat_1 0 0\<^esub> 0"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_1_CId_app cs_intro: cat_cs_intros
	)
	from assms(6) show
	"f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(7) show
	"f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from 0 assms(6) show
	"f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros
	)
	from const assms(5,6) show "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
	by (fold cat_cf_obj_comma_def)
	(cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
	from const assms(5,7) show "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
	by (fold cat_cf_obj_comma_def)
	(
	cs_concl cs_shallow
	cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed (intro assms)+

	lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ArrI

	lemma (in is_functor) cat_obj_cf_comma_ArrI[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [0, a, f]\<^sub>\<circ>"
	and "B = [0, a', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> "
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	shows "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	unfolding cat_obj_cf_comma_def
	proof(intro cat_comma_ArrI cat_comma_HomI)
	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(1) show const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from vempty_is_zet show 0: "0 : 0 \<mapsto>\<^bsub>cat_1 0 0\<^esub> 0"
	by (cs_concl cs_shallow cs_simp: cat_1_CId_app cs_intro: cat_cs_intros)
	from assms(6) show
	"f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(7) show
	"f' : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from 0 assms(7) show
	"f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>0\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros
	)
	from const assms(5,6) show "A \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (fold cat_obj_cf_comma_def)
	(cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
	from const assms(5,7) show "B \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (fold cat_obj_cf_comma_def)
	(
	cs_concl cs_shallow
	cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed (intro assms)+

	lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ArrI

	lemma (in is_functor) cat_cf_obj_comma_ArrE[elim]:
	assumes "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains A B a f a' f' g
	where "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, 0, f]\<^sub>\<circ>"
	and "B = [a', 0, f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	proof-
	from cat_comma_ArrE[OF assms(1)[unfolded cat_cf_obj_comma_def]]
	obtain A B
	where F: "F \<in>\<^sub>\<circ> cat_comma_Hom \<FF> (cf_const (cat_1 0 0) \<BB> b) A B"
	and A: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
	by auto
	from assms(2) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from F obtain a b'' f a' b' f' g h
	where F_def: "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, b'', f]\<^sub>\<circ>"
	and B_def: "B = [a', b', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and h: "h : b'' \<mapsto>\<^bsub>cat_1 0 0\<^esub> b'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f_def:
	"f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
	by (elim cat_comma_HomE[OF _ is_functor_axioms const]) blast
	note hb'b'' = cat_1_is_arrD[OF h]
	from F_def have F_def: "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	unfolding hb'b'' by simp
	from A_def have A_def: "A = [a, 0, f]\<^sub>\<circ>"
	unfolding hb'b'' by simp
	from B_def have B_def: "B = [a', 0, f']\<^sub>\<circ>"
	unfolding hb'b'' by simp
	from f have f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from f' have f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from f_def f f' g h have f_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from
	that F_def A_def B_def g f f' f_def
	B[folded cat_cf_obj_comma_def] A[folded cat_cf_obj_comma_def]
	show ?thesis
	by blast
	qed

	lemmas [elim] = is_functor.cat_cf_obj_comma_ArrE[rotated 1]

	lemma (in is_functor) cat_obj_cf_comma_ArrE[elim]:
	assumes "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains A B a f a' f' g
	where "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [0, a, f]\<^sub>\<circ>"
	and "B = [0, a', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof-
	from cat_comma_ArrE[OF assms(1)[unfolded cat_obj_cf_comma_def]]
	obtain A B
	where F: "F \<in>\<^sub>\<circ> cat_comma_Hom (cf_const (cat_1 0 0) \<BB> b) \<FF> A B"
	and A: "A \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by auto
	from assms(2) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from F obtain a b'' f a' b' f' h g
	where F_def: "F = [A, B, [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [b', a, f]\<^sub>\<circ>"
	and B_def: "B = [b'', a', f']\<^sub>\<circ>"
	and h: "h : b' \<mapsto>\<^bsub>cat_1 0 0\<^esub> b''"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and f': "f' : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and f'_def:
	"f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
	by (elim cat_comma_HomE[OF _ const is_functor_axioms]) blast
	note hb'b'' = cat_1_is_arrD[OF h]
	from F_def have F_def: "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	unfolding hb'b'' by simp
	from A_def have A_def: "A = [0, a, f]\<^sub>\<circ>" unfolding hb'b'' by simp
	from B_def have B_def: "B = [0, a', f']\<^sub>\<circ>" unfolding hb'b'' by simp
	from f have f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from f' have f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from f'_def f f' g h have f'_def[symmetric]: "f' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
	unfolding hb'b''
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from
	that F_def A_def B_def g f f' f'_def
	A[folded cat_obj_cf_comma_def] B[folded cat_obj_cf_comma_def]
	show ?thesis
	by blast
	qed

	lemmas [elim] = is_functor.cat_obj_cf_comma_ArrE

	lemma (in is_functor) cat_cf_obj_comma_ArrD[dest]:
	assumes "[[a, b', f]\<^sub>\<circ>, [a', b'', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b' = 0"
	and "b'' = 0"
	and "h = 0"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	and "[a', b'', f']\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	using cat_cf_obj_comma_ArrE[OF assms] by auto

	lemmas [dest] = is_functor.cat_cf_obj_comma_ArrD[rotated 1]

	lemma (in is_functor) cat_obj_cf_comma_ArrD[dest]:
	assumes "[[b', a, f]\<^sub>\<circ>, [b'', a', f']\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b' = 0"
	and "b'' = 0"
	and "h = 0"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and "[b'', a', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	using cat_obj_cf_comma_ArrE[OF assms] by auto

	lemmas [dest] = is_functor.cat_obj_cf_comma_ArrD


	subsubsection\<open>Domain\<close>

	lemma cat_cf_obj_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>)"
	unfolding cat_cf_obj_comma_def cat_comma_components by simp

	lemma cat_cf_obj_comma_Dom_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	unfolding cat_cf_obj_comma_def cat_comma_components by simp

	lemma cat_cf_obj_comma_Dom_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
	using assms(2)
	unfolding assms(1) cat_cf_obj_comma_def cat_comma_components
	by simp

	lemma (in is_functor) cat_cf_obj_comma_Dom_vrange:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Dom_vrange[
	OF is_functor_axioms const, folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma cat_obj_cf_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>)"
	unfolding cat_obj_cf_comma_def cat_comma_components by simp

	lemma cat_obj_cf_comma_Dom_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	unfolding cat_obj_cf_comma_def cat_comma_components by simp

	lemma cat_obj_cf_comma_Dom_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
	using assms(2)
	unfolding assms(1) cat_obj_cf_comma_def cat_comma_components
	by simp

	lemma (in is_functor) cat_obj_cf_comma_Dom_vrange:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Dom_vrange[
	OF const is_functor_axioms, folded cat_obj_cf_comma_def
	]
	)
	qed


	subsubsection\<open>Codomain\<close>

	lemma cat_cf_obj_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>)"
	unfolding cat_cf_obj_comma_def cat_comma_components by simp

	lemma cat_cf_obj_comma_Cod_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	unfolding cat_cf_obj_comma_def cat_comma_components by simp

	lemma cat_cf_obj_comma_Cod_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	using assms(2)
	unfolding assms(1) cat_cf_obj_comma_def cat_comma_components
	by (simp add: nat_omega_simps)

	lemma (in is_functor) cat_cf_obj_comma_Cod_vrange:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Cod_vrange[
	OF is_functor_axioms const, folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma cat_obj_cf_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>)"
	unfolding cat_obj_cf_comma_def cat_comma_components by simp

	lemma cat_obj_cf_comma_Cod_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	unfolding cat_obj_cf_comma_def cat_comma_components by simp

	lemma cat_obj_cf_comma_Cod_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	using assms(2)
	unfolding assms(1) cat_obj_cf_comma_def cat_comma_components
	by (simp add: nat_omega_simps)

	lemma (in is_functor) cat_obj_cf_comma_Cod_vrange:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Dom_vrange[
	OF const is_functor_axioms, folded cat_obj_cf_comma_def
	]
	)
	qed


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma (in is_functor) cat_cf_obj_comma_is_arrI[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "ABF = [A, B, F]\<^sub>\<circ>"
	and "A = [a, 0, f]\<^sub>\<circ>"
	and "B = [a', 0, f']\<^sub>\<circ>"
	and "F = [g, 0]\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	shows "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
	proof(intro is_arrI)
	from assms(1,6,7,8) show "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros
	)
	with assms(2) show "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
	qed

	lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_is_arrI

	lemma (in is_functor) cat_obj_cf_comma_is_arrI[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "ABF = [A, B, F]\<^sub>\<circ>"
	and "A = [0, a, f]\<^sub>\<circ>"
	and "B = [0, a', f']\<^sub>\<circ>"
	and "F = [0, g]\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	shows "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
	proof(intro is_arrI)
	from assms(1,6,7,8) show "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros
	)
	with assms(2) show "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
	qed

	lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_is_arrI

	lemma (in is_functor) cat_cf_obj_comma_is_arrD[dest]:
	assumes "[[a, b', f]\<^sub>\<circ>, [a', b'', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> :
	[a, b', f]\<^sub>\<circ> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> [a', b'', f']\<^sub>\<circ>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b' = 0"
	and "b'' = 0"
	and "h = 0"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	and "[a', b'', f']\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	by (intro cat_cf_obj_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

	lemma (in is_functor) cat_obj_cf_comma_is_arrD[dest]:
	assumes "[[b', a, f]\<^sub>\<circ>, [b'', a', f']\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> :
	[b', a, f]\<^sub>\<circ> \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [b'', a', f']\<^sub>\<circ>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b' = 0"
	and "b'' = 0"
	and "h = 0"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and "[b'', a', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (intro cat_obj_cf_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

	lemmas [dest] = is_functor.cat_obj_cf_comma_is_arrD

	lemma (in is_functor) cat_cf_obj_comma_is_arrE[elim]:
	assumes "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains a f a' f' g
	where "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [a, 0, f]\<^sub>\<circ>"
	and "B = [a', 0, f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	proof-
	note ABF = is_arrD[OF assms(1)]
	from ABF(1) obtain C D a f a' f' g
	where ABF_def: "ABF = [C, D, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a, 0, f]\<^sub>\<circ>"
	and D_def: "D = [a', 0, f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and f_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	and C: "C \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	and D: "D \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	by (elim cat_cf_obj_comma_ArrE[OF _ assms(2)])
	from ABF(2) assms(2) C_def D_def g f f' f_def have [simp]: "C = A"
	unfolding ABF_def
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	from ABF(3) assms(2) C_def D_def g f f' f_def have [simp]: "D = B"
	unfolding ABF_def
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	from that ABF_def C_def D_def g f f' f_def C D show ?thesis by auto
	qed

	lemmas [elim] = is_functor.cat_cf_obj_comma_is_arrE

	lemma (in is_functor) cat_obj_cf_comma_is_arrE[elim]:
	assumes "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains a f a' f' g
	where "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and "A = [0, a, f]\<^sub>\<circ>"
	and "B = [0, a', f']\<^sub>\<circ>"
	and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof-
	note ABF = is_arrD[OF assms(1)]
	from ABF(1) obtain C D a f a' f' g
	where ABF_def: "ABF = [C, D, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [0, a, f]\<^sub>\<circ>"
	and D_def: "D = [0, a', f']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	and C: "C \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	and D: "D \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (elim cat_obj_cf_comma_ArrE[OF _ assms(2)])
	from ABF(2) assms(2) C_def D_def g f f' f'_def have [simp]: "C = A"
	unfolding ABF_def
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	from ABF(3) assms(2) C_def D_def g f f' f'_def have [simp]: "D = B"
	unfolding ABF_def
	by
	(
	- cs_prems cs_shallow
	+ cs_prems cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)
	from that ABF_def C_def D_def g f f' f'_def C D show ?thesis by auto
	qed

	lemmas [elim] = is_functor.cat_obj_cf_comma_is_arrE


	subsubsection\<open>Composition\<close>

	lemma cat_cf_obj_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Comp\<rparr>)"
	unfolding cat_cf_obj_comma_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma cat_obj_cf_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Comp\<rparr>)"
	unfolding cat_obj_cf_comma_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma (in is_functor) cat_cf_obj_comma_Comp_app[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "BCG = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "BCG : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
	shows "BCG \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> ABF = [A, C, [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(4) obtain a f a' f' g
	where BCG_def: "BCG = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
	from assms(5) obtain a f a' f' g
	where ABF_def: "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
	from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
	"h' = 0" "h = 0"
	by simp_all
	have "h' \<circ>\<^sub>A\<^bsub>cat_1 0 0\<^esub> h = 0" by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	by
	(
	rule cat_comma_Comp_app
	[
	OF
	is_functor_axioms
	const
	assms(2,3)
	assms(4)[unfolded cat_cf_obj_comma_def]
	assms(5)[unfolded cat_cf_obj_comma_def],
	folded cat_cf_obj_comma_def,
	unfolded cat_cs_simps
	]
	)
	qed

	lemma (in is_functor) cat_obj_cf_comma_Comp_app[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "BCG = [B, C, [h', g']\<^sub>\<circ>]\<^sub>\<circ>"
	and "ABF = [A, B, [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and "BCG : B \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
	shows "BCG \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> ABF = [A, C, [0, g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(4) obtain a f a' f' g
	where BCG_def: "BCG = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
	from assms(5) obtain a f a' f' g
	where ABF_def: "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
	from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
	"h' = 0" "h = 0"
	by simp_all
	have "h' \<circ>\<^sub>A\<^bsub>cat_1 0 0\<^esub> h = 0" by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	by
	(
	rule cat_comma_Comp_app
	[
	OF
	const
	is_functor_axioms
	assms(2,3)
	assms(4)[unfolded cat_obj_cf_comma_def]
	assms(5)[unfolded cat_obj_cf_comma_def],
	folded cat_obj_cf_comma_def,
	unfolded cat_cs_simps
	]
	)
	qed

	lemma (in is_functor) cat_cf_obj_comma_Comp_is_arr[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "BCG : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
	shows "BCG \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Comp_is_arr
	[
	OF
	is_functor_axioms
	const
	assms(2)[unfolded cat_cf_obj_comma_def]
	assms(3)[unfolded cat_cf_obj_comma_def],
	folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_functor) cat_obj_cf_comma_Comp_is_arr[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "BCG : B \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C"
	and "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
	shows "BCG \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_Comp_is_arr
	[
	OF
	const
	is_functor_axioms
	assms(2)[unfolded cat_obj_cf_comma_def]
	assms(3)[unfolded cat_obj_cf_comma_def],
	folded cat_obj_cf_comma_def
	]
	)
	qed


	subsubsection\<open>Identity\<close>

	lemma cat_cf_obj_comma_CId_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>)"
	unfolding cat_cf_obj_comma_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma cat_obj_cf_comma_CId_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>)"
	unfolding cat_obj_cf_comma_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma (in is_functor) cat_cf_obj_comma_CId_vdomain[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule cat_comma_CId_vdomain[
	OF is_functor_axioms const, folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_functor) cat_obj_cf_comma_CId_vdomain[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by
	(
	rule cat_comma_CId_vdomain[
	OF const is_functor_axioms, folded cat_obj_cf_comma_def
	]
	)
	qed

	lemma (in is_functor) cat_cf_obj_comma_CId_app[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A = [a, b', f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(3,2) have b'_def: "b' = 0"
	by (auto elim: cat_cf_obj_comma_ObjE[OF _ assms(1)])
	have [cat_cs_simps]: "cat_1 0 0\<lparr>CId\<rparr>\<lparr>b'\<rparr> = 0"
	unfolding cat_1_components b'_def by simp
	show ?thesis
	by
	(
	rule cat_comma_CId_app
	[
	OF
	is_functor_axioms
	const
	assms(2,3)[unfolded cat_cf_obj_comma_def],
	unfolded cat_cf_obj_comma_def[symmetric] cat_cs_simps
	]
	)
	qed

	lemma (in is_functor) cat_obj_cf_comma_CId_app[cat_comma_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A = [b', a, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [0, \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	from assms(3,2) have b'_def: "b' = 0"
	by (auto elim: cat_obj_cf_comma_ObjE[OF _ assms(1)])
	have [cat_cs_simps]: "cat_1 0 0\<lparr>CId\<rparr>\<lparr>b'\<rparr> = 0"
	unfolding cat_1_components b'_def by simp
	show ?thesis
	by
	(
	rule cat_comma_CId_app
	[
	OF
	const
	is_functor_axioms
	assms(2,3)[unfolded cat_obj_cf_comma_def],
	unfolded cat_obj_cf_comma_def[symmetric] cat_cs_simps
	]
	)
	qed


	subsubsection\<open>
	Comma categories constructed from a functor and an object are categories
	\<close>

	lemma (in is_functor) category_cat_cf_obj_comma[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> b)"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule category_cat_comma[
	OF is_functor_axioms const, folded cat_cf_obj_comma_def
	]
	)
	qed

	lemmas [cat_comma_cs_intros] = is_functor.category_cat_cf_obj_comma

	lemma (in is_functor) category_cat_obj_cf_comma[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "category \<alpha> (b \<down>\<^sub>C\<^sub>F \<FF>)"
	proof-
	from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
	show ?thesis
	by
	(
	rule category_cat_comma[
	OF const is_functor_axioms, folded cat_obj_cf_comma_def
	]
	)
	qed

	lemmas [cat_comma_cs_intros] = is_functor.category_cat_obj_cf_comma


	subsubsection\<open>Tiny comma categories constructed from a functor and an object\<close>

	lemma (in is_tm_functor) tiny_category_cat_cf_obj_comma[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "tiny_category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> b)"
	proof-
	from assms(1) have const:
	"cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_small_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule tiny_category_cat_comma[
	OF is_tm_functor_axioms const, folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_tm_functor) tiny_category_cat_obj_cf_comma[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "tiny_category \<alpha> (b \<down>\<^sub>C\<^sub>F \<FF>)"
	proof-
	from assms(1) have const:
	"cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: vempty_is_zet cat_small_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule tiny_category_cat_comma[
	OF const is_tm_functor_axioms, folded cat_obj_cf_comma_def
	]
	)
	qed



	subsection\<open>
	Opposite comma category functors for the comma categories
	constructed from a functor and an object
	\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	definition op_cf_obj_comma :: "V \<Rightarrow> V \<Rightarrow> V"
	where "op_cf_obj_comma \<FF> b =
	op_cf_comma \<FF> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"

	definition op_obj_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V"
	where "op_obj_cf_comma b \<FF> =
	op_cf_comma (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<FF>"


	text\<open>Alternative forms of the definitions.\<close>

	lemma (in is_functor) op_cf_obj_comma_def:
	"op_cf_obj_comma \<FF> b = op_cf_comma \<FF> (cf_const (cat_1 0 0) \<BB> b)"
	unfolding op_cf_obj_comma_def cat_cs_simps by simp

	lemma (in is_functor) op_obj_cf_comma_def:
	"op_obj_cf_comma b \<FF> = op_cf_comma (cf_const (cat_1 0 0) \<BB> b) \<FF>"
	unfolding op_obj_cf_comma_def cat_cs_simps by simp


	subsubsection\<open>Object map\<close>

	lemma op_cf_obj_comma_ObjMap_vsv[cat_comma_cs_intros]:
	"vsv (op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>)"
	unfolding op_cf_obj_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)

	lemma op_obj_cf_comma_ObjMap_vsv[cat_comma_cs_intros]:
	"vsv (op_obj_cf_comma b \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding op_obj_cf_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)

	lemma (in is_functor) op_cf_obj_comma_ObjMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	unfolding op_cf_obj_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric]
	)

	lemma (in is_functor) op_obj_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (op_obj_cf_comma b \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	unfolding op_obj_cf_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric]
	)

	lemma (in is_functor) op_cf_obj_comma_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a, 0, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	shows "op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [0, a, f]\<^sub>\<circ>"
	proof-
	have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	by (intro cat_cf_obj_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
	from assms(2) a f show ?thesis
	using assms(2)
	unfolding assms(1) op_cf_obj_comma_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	qed

	lemma (in is_functor) op_obj_cf_comma_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [0, a, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	shows "op_obj_cf_comma b \<FF> \<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a, 0, f]\<^sub>\<circ>"
	proof-
	have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (intro cat_obj_cf_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
	from assms(2) a f show ?thesis
	using assms(2)
	unfolding assms(1) op_obj_cf_comma_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma op_cf_obj_comma_ArrMap_vsv[cat_comma_cs_intros]:
	"vsv (op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>)"
	unfolding op_cf_obj_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)

	lemma op_obj_cf_comma_ArrMap_vsv[cat_comma_cs_intros]:
	"vsv (op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding op_obj_cf_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	)

	lemma (in is_functor) op_cf_obj_comma_ArrMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	unfolding op_cf_obj_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric]
	)

	lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_vdomain

	lemma (in is_functor) op_obj_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	unfolding op_obj_cf_comma_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric]
	)

	lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_vdomain

	lemma (in is_functor) op_cf_obj_comma_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	shows "op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = [[0, a', f']\<^sub>\<circ>, [0, a, f]\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(3) have g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and [cat_comma_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
	by (intro cat_cf_obj_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
	from assms(2) g f f' show ?thesis
	unfolding assms(1) op_cf_obj_comma_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
	cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
	)
	qed

	lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_app

	lemma (in is_functor) op_obj_cf_comma_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	shows "op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = [[a', 0, f']\<^sub>\<circ>, [a, 0, f]\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(3) have h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and [cat_comma_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	by (intro cat_obj_cf_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
	from assms(2) h f f' show ?thesis
	unfolding assms(1) op_obj_cf_comma_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
	cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
	)
	qed

	lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_app


	subsubsection\<open>
	Opposite comma category functors for the comma categories
	constructed from a functor and an object are isomorphisms of categories
	\<close>

	lemma (in is_functor) op_cf_obj_comma_is_iso_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_cf_obj_comma \<FF> b : op_cat (\<FF> \<^sub>C\<^sub>F\<down> b) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	proof-
	from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	note cat_obj_cf_comma_def =
	is_functor.cat_obj_cf_comma_def[
	OF is_functor_op, unfolded cat_op_simps
	]
	show ?thesis
	by
	(
	rule op_cf_comma_is_iso_functor
	[
	OF is_functor_axioms cf_const,
	folded cat_cf_obj_comma_def op_cf_obj_comma_def,
	unfolded cat_op_simps,
	folded cat_obj_cf_comma_def
	]
	)
	qed

	lemma (in is_functor) op_cf_obj_comma_is_iso_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = op_cat (\<FF> \<^sub>C\<^sub>F\<down> b)"
	and "\<BB>' = b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	shows "op_cf_obj_comma \<FF> b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_iso_functor)

	lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_iso_functor'

	lemma (in is_functor) op_cf_obj_comma_is_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_cf_obj_comma \<FF> b : op_cat (\<FF> \<^sub>C\<^sub>F\<down> b) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	by (rule is_iso_functorD(1)[OF op_cf_obj_comma_is_iso_functor[OF assms]])

	lemma (in is_functor) op_cf_obj_comma_is_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = op_cat (\<FF> \<^sub>C\<^sub>F\<down> b)"
	and "\<BB>' = b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	shows "op_cf_obj_comma \<FF> b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_functor)

	lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_functor'

	lemma (in is_functor) op_obj_cf_comma_is_iso_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_obj_cf_comma b \<FF> : op_cat (b \<down>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
	proof-
	from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	note cat_cf_obj_comma_def =
	is_functor.cat_cf_obj_comma_def[
	OF is_functor_op, unfolded cat_op_simps
	]
	show ?thesis
	by
	(
	rule op_cf_comma_is_iso_functor
	[
	OF cf_const is_functor_axioms,
	folded cat_obj_cf_comma_def op_obj_cf_comma_def,
	unfolded cat_op_simps,
	folded cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_functor) op_obj_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = op_cat (b \<down>\<^sub>C\<^sub>F \<FF>)"
	and "\<BB>' = (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
	shows "op_obj_cf_comma b \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_iso_functor)

	lemmas [cat_comma_cs_intros] = is_functor.op_obj_cf_comma_is_iso_functor'

	lemma (in is_functor) op_obj_cf_comma_is_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_obj_cf_comma b \<FF> : op_cat (b \<down>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
	by (rule is_iso_functorD(1)[OF op_obj_cf_comma_is_iso_functor[OF assms]])

	lemma (in is_functor) op_obj_cf_comma_is_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = op_cat (b \<down>\<^sub>C\<^sub>F \<FF>)"
	and "\<BB>' = (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
	shows "op_obj_cf_comma b \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_functor)



	subsection\<open>
	Projections for comma categories constructed from a functor and an object
	\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	definition cf_cf_obj_comma_proj :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<Sqinter>\<^sub>O _)\<close> [1000, 1000] 999)
	where "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<equiv> \<FF> \<^sub>C\<^sub>F\<Sqinter> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"

	definition cf_obj_cf_comma_proj :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>O\<Sqinter>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
	where "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<equiv> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<Sqinter>\<^sub>C\<^sub>F \<FF>"


	text\<open>Alternative forms of the definitions.\<close>

	lemma (in is_functor) cf_cf_obj_comma_proj_def:
	"\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b = \<FF> \<^sub>C\<^sub>F\<Sqinter> (cf_const (cat_1 0 0) \<BB> b)"
	unfolding cf_cf_obj_comma_proj_def cf_HomCod..

	lemma (in is_functor) cf_obj_cf_comma_proj_def:
	"b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> = (cf_const (cat_1 0 0) \<BB> b) \<Sqinter>\<^sub>C\<^sub>F \<FF>"
	unfolding cf_obj_cf_comma_proj_def cf_HomCod..


	text\<open>Components.\<close>

	lemma (in is_functor) cf_cf_obj_comma_proj_components[cat_comma_cs_simps]:
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> b"
	and "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>HomCod\<rparr> = \<AA>"
	unfolding
	cf_cf_obj_comma_proj_def
	cf_comma_proj_left_components
	cat_cf_obj_comma_def[symmetric]
	cat_cs_simps
	by simp_all

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_components

	lemma (in is_functor) cf_obj_cf_comma_proj_components[cat_comma_cs_simps]:
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = b \<down>\<^sub>C\<^sub>F \<FF>"
	and "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = \<AA>"
	unfolding
	cf_obj_cf_comma_proj_def
	cf_comma_proj_right_components
	cat_obj_cf_comma_def[symmetric]
	cat_cs_simps
	by simp_all

	lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_components


	subsubsection\<open>Object map\<close>

	lemma cf_cf_obj_comma_proj_ObjMap_vsv[cat_comma_cs_intros]:
	"vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>)"
	unfolding cf_cf_obj_comma_proj_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma cf_obj_cf_comma_proj_ObjMap_vsv[cat_comma_cs_intros]:
	"vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding cf_obj_cf_comma_proj_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ObjMap_vdomain
	unfolding
	cf_cf_obj_comma_proj_def[symmetric]
	cf_comma_proj_left_components[symmetric]
	cat_comma_cs_simps
	by simp

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

	lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ObjMap_vdomain
	unfolding
	cf_obj_cf_comma_proj_def[symmetric]
	cf_comma_proj_right_components[symmetric]
	cat_comma_cs_simps
	by simp

	lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_vdomain

	lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a, b', f]\<^sub>\<circ>" and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
	by
	(
	rule cf_comma_proj_left_ObjMap_app[
	OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def],
	folded cf_cf_obj_comma_proj_def
	]
	)

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_app

	lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [b', a, f]\<^sub>\<circ>" and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
	by
	(
	rule cf_comma_proj_right_ObjMap_app[
	OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def],
	folded cf_obj_cf_comma_proj_def
	]
	)

	lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	lemma cf_cf_obj_comma_proj_ArrMap_vsv[cat_comma_cs_intros]:
	"vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>)"
	unfolding cf_cf_obj_comma_proj_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma cf_obj_cf_comma_proj_ArrMap_vsv[cat_comma_cs_intros]:
	"vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding cf_obj_cf_comma_proj_def
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ArrMap_vdomain
	unfolding
	cf_cf_obj_comma_proj_def[symmetric]
	cf_comma_proj_left_components[symmetric]
	cat_comma_cs_simps
	by simp

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

	lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
	"\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ArrMap_vdomain
	unfolding
	cf_obj_cf_comma_proj_def[symmetric]
	cf_comma_proj_right_components[symmetric]
	cat_comma_cs_simps
	by simp

	lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_vdomain

	lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = g"
	by
	(
	rule cf_comma_proj_left_ArrMap_app[
	OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def],
	folded cf_cf_obj_comma_proj_def
	]
	)

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ArrMap_app

	lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_app[cat_comma_cs_simps]:
	assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = h"
	by
	(
	rule cf_comma_proj_right_ArrMap_app[
	OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def],
	folded cf_obj_cf_comma_proj_def
	]
	)

	lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_app


	subsubsection\<open>Projections for a comma category are functors\<close>

	lemma (in is_functor) cf_cf_obj_comma_proj_is_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule cf_comma_proj_left_is_functor[
	OF is_functor_axioms const,
	folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_functor) cf_cf_obj_comma_proj_is_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = \<FF> \<^sub>C\<^sub>F\<down> b"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_functor)

	lemmas [cat_comma_cs_intros] = is_functor.cf_cf_obj_comma_proj_is_functor'

	lemma (in is_functor) cf_obj_cf_comma_proj_is_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule cf_comma_proj_right_is_functor[
	OF const is_functor_axioms,
	folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
	]
	)
	qed

	lemma (in is_functor) cf_obj_cf_comma_proj_is_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = b \<down>\<^sub>C\<^sub>F \<FF>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_functor)

	lemmas [cat_comma_cs_intros] = is_functor.cf_obj_cf_comma_proj_is_functor'


	subsubsection\<open>
	Opposite projections for comma categories constructed from a functor
	and an object
	\<close>

	lemma (in is_functor) op_cf_cf_obj_comma_proj:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_cf (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b) = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> b"
	proof-
	from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule op_cf_comma_proj_left
	[
	OF is_functor_axioms cf_const,
	unfolded cat_op_simps,
	folded
	cf_cf_obj_comma_proj_def
	op_cf_obj_comma_def
	is_functor.cf_obj_cf_comma_proj_def[
	OF is_functor_op, unfolded cat_op_simps
	]
	]
	)
	qed

	lemma (in is_functor) op_cf_obj_cf_comma_proj:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "op_cf (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>) = (op_cf \<FF>) \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F op_obj_cf_comma b \<FF>"
	proof-
	from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule op_cf_comma_proj_right
	[
	OF cf_const is_functor_axioms,
	unfolded cat_op_simps,
	folded
	cf_obj_cf_comma_proj_def
	op_obj_cf_comma_def
	is_functor.cf_cf_obj_comma_proj_def[
	OF is_functor_op, unfolded cat_op_simps
	]
	]
	)
	qed


	subsubsection\<open>Projections for a tiny comma category\<close>

	lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule cf_comma_proj_left_is_tm_functor[
	OF is_tm_functor_axioms const,
	folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
	]
	)
	qed

	lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<FF>b = \<FF> \<^sub>C\<^sub>F\<down> b"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF>b \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_tm_functor)

	lemmas [cat_comma_cs_intros] = is_tm_functor.cf_cf_obj_comma_proj_is_tm_functor'

	lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
	show ?thesis
	by
	(
	rule cf_comma_proj_right_is_tm_functor[
	OF const is_tm_functor_axioms,
	folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
	]
	)
	qed

	lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = b \<down>\<^sub>C\<^sub>F \<FF>"
	shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_tm_functor)

	lemmas [cat_comma_cs_intros] = is_tm_functor.cf_obj_cf_comma_proj_is_tm_functor'

	+lemma cf_comp_cf_cf_obj_comma_proj_is_tm_functor[cat_comma_cs_intros]:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<GG> \<^sub>C\<^sub>F\<down> c"
	+ and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows "\<GG> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	+proof-
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
	+ from assms(3) have cf_const: "cf_const (cat_1 0 0) \<CC> c : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	+ show ?thesis
	+ by
	+ (
	+ rule cf_comp_cf_comma_proj_left_is_tm_functor
	+ [
	+ OF assms(1) _ assms(2)[unfolded cat_cf_obj_comma_def],
	+ unfolded cat_cs_simps,
	+ OF cf_const,
	+ folded \<GG>.cf_cf_obj_comma_proj_def
	+ ]
	+ )
	+qed
	+
	+lemma cf_comp_cf_obj_cf_comma_proj_is_tm_functor[cat_comma_cs_intros]:
	+ assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> c \<down>\<^sub>C\<^sub>F \<HH>"
	+ and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows "c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof-
	+ interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
	+ from assms(3) have cf_const: "cf_const (cat_1 0 0) \<CC> c : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	+ show ?thesis
	+ by
	+ (
	+ rule cf_comp_cf_comma_proj_right_is_tm_functor
	+ [
	+ OF _ assms(1) assms(2)[unfolded cat_obj_cf_comma_def],
	+ unfolded cat_cs_simps,
	+ OF cf_const,
	+ folded \<HH>.cf_obj_cf_comma_proj_def
	+ ]
	+ )
	+qed
	+


	subsection\<open>Comma functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_arr_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_ \<^sub>A\<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
	where "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> =
	[
	(\<lambda>A\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>),
	(
	\<lambda>F\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
	[
	[0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
	[0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	),
	(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>,
	(\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>
	]\<^sub>\<circ>"

	definition cf_cf_arr_comma :: "V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_ \<^sub>C\<^sub>F\<down>\<^sub>A _)\<close> [1000, 1000] 999)
	where "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g =
	[
	(\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
	(
	\<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Arr\<rparr>.
	[
	[F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	[F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	),
	\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>),
	\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_arr_cf_comma_components:
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> =
	(\<lambda>A\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>)"
	and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>F\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
	[
	[0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
	[0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	)"
	and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>"
	and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>"
	unfolding cf_arr_cf_comma_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	lemma cf_cf_arr_comma_components:
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr> =
	(\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
	and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr> =
	(
	\<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Arr\<rparr>.
	[
	[F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	[F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	)"
	and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)"
	and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomCod\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)"
	unfolding cf_cf_arr_comma_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	context is_functor
	begin

	lemma cf_arr_cf_comma_components':
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>)"
	and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>F\<in>\<^sub>\<circ>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
	[
	[0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>,
	[0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	)"
	and [cat_comma_cs_simps]: "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = c' \<down>\<^sub>C\<^sub>F \<FF>"
	and [cat_comma_cs_simps]: "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>"
	using assms
	unfolding cf_arr_cf_comma_components
	by (simp_all add: cat_cs_simps)

	lemma cf_cf_arr_comma_components':
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
	and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr> =
	(
	\<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Arr\<rparr>.
	[
	[F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	[F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
	F\<lparr>2\<^sub>\<nat>\<rparr>
	]\<^sub>\<circ>
	)"
	and [cat_comma_cs_simps]: "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c"
	and [cat_comma_cs_simps]: "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomCod\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c'"
	using assms
	unfolding cf_cf_arr_comma_components
	by (simp_all add: cat_cs_simps)

	end

	lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_components'(3,4)
	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_components'(3,4)


	subsubsection\<open>Object map\<close>

	mk_VLambda cf_arr_cf_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
	\|vsv cf_arr_cf_comma_ObjMap_vsv[cat_comma_cs_intros]\|

	mk_VLambda cf_cf_arr_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
	\|vsv cf_cf_arr_comma_ObjMap_vsv[cat_comma_cs_intros]\|

	context is_functor
	begin

	context
	fixes g c c'
	assumes g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	begin

	mk_VLambda
	cf_arr_cf_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
	\|vdomain cf_arr_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]\|

	mk_VLambda
	cf_cf_arr_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
	\|vdomain cf_cf_arr_comma_ObjMap_vdomain[cat_comma_cs_simps]\|

	end

	end

	lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_vdomain
	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_vdomain

	lemma (in is_functor) cf_arr_cf_comma_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a', b', f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>"
	proof-
	from assms have b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and a'_def: "a' = 0"
	by auto
	from assms(2) show ?thesis
	unfolding cf_arr_cf_comma_components'[OF assms(3)] assms(1)
	by (simp add: nat_omega_simps a'_def)
	qed

	lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
	assumes "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>" and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a', b', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f']\<^sub>\<circ>"
	proof-
	from assms have b'_def: "b' = 0"
	and f: "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by auto
	from assms(2) show ?thesis
	unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
	by (simp add: nat_omega_simps b'_def)
	qed

	lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_app
	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_app

	lemma (in is_functor) cf_arr_cf_comma_ObjMap_vrange:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<R>\<^sub>\<circ> (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_arr_cf_comma_ObjMap_vdomain[OF assms]
	)
	fix A assume "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	with assms is_functor_axioms obtain a f
	where A_def: "A = [0, a, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by auto
	from assms a f show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps A_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
	)
	fix A assume "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>"
	with assms is_functor_axioms obtain a f
	where A_def: "A = [a, 0, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	by auto
	from assms a f show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps A_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)


	subsubsection\<open>Arrow map\<close>

	mk_VLambda cf_arr_cf_comma_components(2)
	\|vsv cf_arr_cf_comma_ArrMap_vsv[cat_comma_cs_intros]\|

	mk_VLambda cf_cf_arr_comma_components(2)
	\|vsv cf_cf_arr_comma_ArrMap_vsv[cat_comma_cs_intros]\|

	context is_functor
	begin

	context
	fixes g c c'
	assumes g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	begin

	mk_VLambda
	cf_arr_cf_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
	\|vdomain cf_arr_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]\|

	mk_VLambda
	cf_cf_arr_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
	\|vdomain cf_cf_arr_comma_ArrMap_vdomain[cat_comma_cs_simps]\|

	end

	end

	lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_vdomain
	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_vdomain

	lemma (in is_functor) cf_arr_cf_comma_ArrMap_app[cat_comma_cs_simps]:
	assumes "A = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
	and "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ> :
	[a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [a', b', f']\<^sub>\<circ>"
	and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> =
	[[a, b, f \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>, [a', b', f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(3) have c': "c' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	from
	cat_obj_cf_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c']
	is_arrD(1)[OF assms(2)]
	show ?thesis
	unfolding assms(1) cf_arr_cf_comma_components'[OF assms(3)]
	by (simp_all add: nat_omega_simps)
	qed

	lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_app

	lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
	assumes "A = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
	and "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ> :
	[a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> [a', b', f']\<^sub>\<circ>"
	and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> =
	[[a, b, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f]\<^sub>\<circ>, [a', b', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
	proof-
	from assms(3) have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	from
	cat_cf_obj_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c]
	is_arrD(1)[OF assms(2)]
	show ?thesis
	unfolding assms(1) cf_cf_arr_comma_components'[OF assms(3)]
	by (simp_all add: nat_omega_simps)
	qed

	lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_app


	subsubsection\<open>Comma functors are functors\<close>

	lemma (in is_functor) cf_arr_cf_comma_is_functor:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : c' \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c \<down>\<^sub>C\<^sub>F \<FF>"
	proof(rule is_functorI')
	show "vfsequence (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)" unfolding cf_arr_cf_comma_def by simp
	from assms show "category \<alpha> (c' \<down>\<^sub>C\<^sub>F \<FF>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms show "category \<alpha> (c \<down>\<^sub>C\<^sub>F \<FF>)"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	show "vcard (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"
	unfolding cf_arr_cf_comma_def by (simp_all add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (intro cf_arr_cf_comma_ObjMap_vrange)
	show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
	g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for A B F
	proof-
	from assms that obtain b f b' f' k
	where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b, f]\<^sub>\<circ>"
	and B_def: "B = [0, b', f']\<^sub>\<circ>"
	and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
	and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	by auto
	from assms that k f f' show ?thesis
	unfolding F_def A_def B_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> F\<rparr> =
	g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C" and "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for B C G A F
	proof-
	from that(2) assms obtain b f b' f' k
	where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b, f]\<^sub>\<circ>"
	and B_def: "B = [0, b', f']\<^sub>\<circ>"
	and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
	and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
	by auto
	with that(1) assms obtain b'' f'' k'
	where G_def: "G = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, k']\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [0, b'', f'']\<^sub>\<circ>"
	and k': "k' : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
	and f'': "f'' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
	by auto (slow)
	from assms that k f f' f'' k' show ?thesis
	unfolding F_def G_def A_def B_def C_def
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_comma_cs_simps
	f''_def[symmetric] f'_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" for C
	proof-
	from that assms obtain a f
	where C_def: "C = [0, a, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by auto
	from a assms f show
	"g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	unfolding C_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	\<close>
	)+

	lemma (in is_functor) cf_cf_arr_comma_is_functor:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g : \<FF> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> c'"
	proof(rule is_functorI')
	from assms have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	show "vfsequence (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g)" unfolding cf_cf_arr_comma_def by simp
	from assms show "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> c')"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms show "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> c)"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	show "vcard (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) = 4\<^sub>\<nat>"
	unfolding cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
	by (intro cf_cf_arr_comma_ObjMap_vrange)
	show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
	\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c'\<^esub> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" for A B F
	proof-
	from assms that obtain a f a' f' h
	where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, 0, f]\<^sub>\<circ>"
	and B_def: "B = [a', 0, f']\<^sub>\<circ>"
	and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and f'_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
	by auto
	from assms that h f f' show ?thesis
	unfolding F_def A_def B_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> F\<rparr> =
	\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c'\<^esub> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> C" and "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" for B C G A F
	proof-
	from that(2) assms obtain a f a' f' h
	where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, 0, f]\<^sub>\<circ>"
	and B_def: "B = [a', 0, f']\<^sub>\<circ>"
	and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
	by auto
	with that(1) assms obtain a'' f'' h'
	where G_def: "G = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [h', 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and C_def: "C = [a'', 0, f'']\<^sub>\<circ>"
	and h': "h' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> = f'"
	by auto (slow)
	note [cat_cs_simps] = category.cat_assoc_helper[
	where \<CC>=\<BB>, where h=f'' and g=\<open>\<FF>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr>\<close> and q=f'
	]
	from assms that c h f f' f'' h' show ?thesis
	unfolding F_def G_def A_def B_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>CId\<rparr>\<lparr>\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>" for C
	proof-
	from that assms obtain a f
	where C_def: "C = [a, 0, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	by auto
	from a c assms f show ?thesis
	unfolding C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	\<close>
	)+

	lemma (in is_functor) cf_arr_cf_comma_is_functor'[cat_comma_cs_intros]:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'" and "\<AA>' = c' \<down>\<^sub>C\<^sub>F \<FF>" and "\<BB>' = c \<down>\<^sub>C\<^sub>F \<FF>"
	shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cf_arr_cf_comma_is_functor(1))

	lemmas [cat_comma_cs_intros] = is_functor.cf_arr_cf_comma_is_functor'

	lemma (in is_functor) cf_cf_arr_comma_is_functor'[cat_comma_cs_intros]:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'" and "\<AA>' = \<FF> \<^sub>C\<^sub>F\<down> c" and "\<BB>' = \<FF> \<^sub>C\<^sub>F\<down> c'"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cf_cf_arr_comma_is_functor(1))

	lemmas [cat_comma_cs_intros] = is_functor.cf_cf_arr_comma_is_functor'

	lemma (in is_functor) cf_arr_cf_comma_CId:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)"
	proof(rule cf_eqI)
	from vempty_is_zet assms show "cf_id (b \<down>\<^sub>C\<^sub>F \<FF>) : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from vempty_is_zet assms show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	from assms have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	with assms obtain a' f'
	where A_def: "A = [0, a', f']\<^sub>\<circ>"
	and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	by auto
	from prems assms vempty_is_zet a' f' show
	"(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)+
	from assms have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	from assms have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix F assume prems: "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" by (auto dest: is_arrI)
	from assms F obtain b' f' b'' f'' h
	where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b', f']\<^sub>\<circ>"
	and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
	and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
	by auto
	from assms prems F h f' f'' show
	"(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros cat_cs_intros)+
	qed simp_all

	lemma (in is_functor) cf_cf_arr_comma_CId:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)"
	proof(rule cf_eqI)
	from vempty_is_zet assms show "cf_id (\<FF> \<^sub>C\<^sub>F\<down> b) : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> b"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from vempty_is_zet assms show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> b"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	from assms have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
	with assms obtain a' f'
	where A_def: "A = [a', 0, f']\<^sub>\<circ>"
	and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	by auto
	from prems assms vempty_is_zet a' f' show
	"\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)+
	from assms have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	from assms have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (\<FF> \<down>\<^sub>C\<^sub>F b)\<lparr>ArrMap\<rparr>) = \<FF> \<down>\<^sub>C\<^sub>F b\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix F assume prems: "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B" by (auto dest: is_arrI)
	from assms F obtain a' f' a'' f'' k
	where F_def: "F = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [k, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a', 0, f']\<^sub>\<circ>"
	and B_def: "B = [a'', 0, f'']\<^sub>\<circ>"
	and k: "k : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = f'"
	by auto
	from assms prems F k f' f'' show
	"\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros cat_cs_intros
	)+
	qed simp_all


	subsubsection\<open>Comma functors and projections\<close>

	lemma (in is_functor)
	cf_cf_comp_cf_obj_cf_comma_proj_cf_arr_cf_comma[cat_comma_cs_simps]:
	assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows "a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>"
	proof(rule cf_eqI)
	from assms vempty_is_zet show "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms show "a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	from assms show "vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	with assms obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	from prems assms b' f' show
	"(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	(
	use assms vempty_is_zet in
	\<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
	)
	from assms have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms vempty_is_zet have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	from assms vempty_is_zet have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix F assume "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
	by (auto dest: is_arrI)
	with assms obtain b' f' b'' f'' h
	where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b', f']\<^sub>\<circ>"
	and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
	and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
	and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
	by auto
	from vempty_is_zet h assms f' f'' F show
	"(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+
	qed
	(
	use assms vempty_is_zet in
	\<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
	)
	qed simp_all

	lemma (in is_functor)
	cf_cf_comp_cf_cf_obj_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]:
	assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a"
	proof(rule cf_eqI)
	from assms vempty_is_zet show "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a : \<FF> \<^sub>C\<^sub>F\<down> a \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms show "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f : \<FF> \<^sub>C\<^sub>F\<down> a \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	show "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	from assms show "vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	fix A assume prems: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
	with assms obtain a' f'
	where A_def: "A = [a', 0, f']\<^sub>\<circ>"
	and b': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
	by auto
	from prems assms b' f' show
	"(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	(
	use assms vempty_is_zet in
	\<open>cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
	)
	from assms vempty_is_zet have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
	show "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix F assume "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> a\<^esub> B" by (auto dest: is_arrI)
	with assms obtain a' f' a'' f'' k
	where F_def: "F = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [k, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a', 0, f']\<^sub>\<circ>"
	and B_def: "B = [a'', 0, f'']\<^sub>\<circ>"
	and k: "k : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
	and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
	and f'_def: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = f'"
	by auto
	from vempty_is_zet k assms f' f'' F show
	"(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)+
	qed
	(
	use assms vempty_is_zet in
	\<open>cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
	)
	qed simp_all


	subsubsection\<open>Opposite comma functors\<close>

	lemma (in is_functor) cf_op_cf_obj_comma_cf_arr_cf_comma:
	assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	shows
	"op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) =
	g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c"
	proof(rule cf_eqI)
	from assms interpret \<FF>c: category \<alpha> \<open>\<FF> \<^sub>C\<^sub>F\<down> c\<close>
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	from assms show "op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) :
	op_cat (\<FF> \<^sub>C\<^sub>F\<down> c) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c' \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	then have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr>) =
	(op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Obj\<rparr>"
	and ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr>) =
	(op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)+
	from assms show
	"g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c :
	op_cat (\<FF> \<^sub>C\<^sub>F\<down> c) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c' \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	then have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>) =
	(op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Obj\<rparr>"
	and ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>) =
	(op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)+
	show
	"(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr> =
	(g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_op_simps)
	fix A assume "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>"
	with assms obtain a f
	where A_def: "A = [a, 0, f]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	by auto
	from assms a f show
	- "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	- (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	+ "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	+ (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	use assms in
	\<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros\<close>
	)+
	show
	"(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr> =
	(g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs cat_op_simps)
	fix F assume "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" by auto
	with assms c obtain a f a' f' h
	where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a, 0, f]\<^sub>\<circ>"
	and B_def: "B = [a', 0, f']\<^sub>\<circ>"
	and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and [cat_comma_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
	by auto
	from F assms h f f' c show
	"(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	qed
	(
	use assms in
	\<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros\<close>
	)+
	qed simp_all

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Conclusions.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Conclusions.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Conclusions.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Conclusions.thy
	@@ -1,38 +1,40 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	theory CZH_ECAT_Conclusions
	imports
	CZH_ECAT_Introduction
	CZH_ECAT_Category
	CZH_ECAT_Small_Category
	CZH_ECAT_Functor
	CZH_ECAT_Small_Functor
	CZH_ECAT_NTCF
	CZH_ECAT_Small_NTCF
	CZH_ECAT_PCategory
	CZH_ECAT_Subcategory
	CZH_ECAT_Simple
	CZH_ECAT_Discrete
	CZH_ECAT_SS
	CZH_ECAT_Parallel
	CZH_ECAT_Comma
	CZH_ECAT_Rel
	CZH_ECAT_Par
	CZH_ECAT_Set
	CZH_ECAT_GRPH
	CZH_ECAT_SemiCAT
	CZH_DG_CAT
	CZH_SMC_CAT
	CZH_ECAT_CAT
	CZH_DG_FUNCT
	CZH_SMC_FUNCT
	CZH_ECAT_FUNCT
	CZH_ECAT_Hom
	+ CZH_ECAT_Cone
	+ CZH_ECAT_Small_Cone
	CZH_ECAT_Yoneda
	CZH_ECAT_Order
	CZH_ECAT_Small_Order
	CZH_ECAT_Ordinal
	CZH_ECAT_CSimplicial
	CZH_ECAT_Structure_Example
	begin
	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Cone.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Cone.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Cone.thy
	@@ -0,0 +1,773 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Cones and cocones\<close>
	+theory CZH_ECAT_Cone
	+ imports
	+ CZH_ECAT_NTCF
	+ CZH_ECAT_Hom
	+ CZH_ECAT_FUNCT
	+begin
	+
	+
	+
	+subsection\<open>Cone and cocone\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+In the context of this work, the concept of a cone corresponds to that of a cone
	+to the base of a functor from a vertex, as defined in Chapter III-4 in
	+\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
	+of a cone from the base of a functor to a vertex, as defined in Chapter III-3
	+in \cite{mac_lane_categories_2010}.
	+\<close>
	+
	+locale is_cat_cone = is_ntcf \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close> \<FF> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	+ assumes cat_cone_obj[cat_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+
	+syntax "_is_cat_cone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_cone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	+
	+locale is_cat_cocone = is_ntcf \<alpha> \<JJ> \<CC> \<FF> \<open>cf_const \<JJ> \<CC> c\<close> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	+ assumes cat_cocone_obj[cat_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+
	+syntax "_is_cat_cocone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_cocone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_cone) is_cat_cone_axioms'[cat_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "\<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_cone_axioms)
	+
	+mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
	+ \|intro is_cat_coneI\|
	+ \|dest is_cat_coneD[dest!]\|
	+ \|elim is_cat_coneE[elim!]\|
	+
	+lemma (in is_cat_cone) is_cat_coneD'[cat_cs_intros]:
	+ assumes "c' = cf_const \<JJ> \<CC> c"
	+ shows "\<NN> : c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding assms by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+
	+lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "\<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_cocone_axioms)
	+
	+mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
	+ \|intro is_cat_coconeI\|
	+ \|dest is_cat_coconeD[dest!]\|
	+ \|elim is_cat_coconeE[elim!]\|
	+
	+lemma (in is_cat_cocone) is_cat_coconeD'[cat_cs_intros]:
	+ assumes "c' = cf_const \<JJ> \<CC> c"
	+ shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding assms by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_cone) is_cat_cocone_op:
	+ "op_ntcf \<NN> : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_coconeI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )+
	+
	+lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	+ shows "op_ntcf \<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_cocone_op)
	+
	+lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'
	+
	+lemma (in is_cat_cocone) is_cat_cone_op:
	+ "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_coneI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	+ shows "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_cone_op)
	+
	+lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_cat_cone) cat_cone_LArr_app_is_arr:
	+ assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+proof-
	+ from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
	+qed
	+
	+lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_cs_intros]:
	+ assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>j"
	+ using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)
	+
	+lemmas [cat_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'
	+
	+lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr:
	+ assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+proof-
	+ from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
	+qed
	+
	+lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_cs_intros]:
	+ assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>j \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)
	+
	+lemmas [cat_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'
	+
	+lemma (in is_cat_cone) cat_cone_Comp_commute[cat_cs_simps]:
	+ assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
	+ shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	+ using ntcf_Comp_commute[symmetric, OF assms] assms
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+thm (not ca_cs_simps) is_cat_cone.cat_cone_Comp_commute
	+
	+lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_cs_simps]:
	+ assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
	+ shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ using ntcf_Comp_commute[OF assms] assms
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps dghm_const_ArrMap_app cs_intro: cat_cs_intros
	+ )
	+
	+thm (not ca_cs_simps) is_cat_cocone.cat_cocone_Comp_commute
	+
	+
	+text\<open>Utilities/helper lemmas.\<close>
	+
	+lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
	+ assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+ from assms(3) have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by simp
	+ from this assms(1,2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+qed
	+
	+lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
	+ assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ shows "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+proof-
	+ interpret \<NN>': is_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	+ show ?thesis
	+ proof(rule ntcf_eqI[OF \<NN>'.is_ntcf_axioms])
	+ from assms(2) show
	+ "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' : cf_const \<JJ> \<CC> c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<NN>'\<lparr>NTMap\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold cat_cs_simps)
	+ show "vsv ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ from assms show "\<JJ>\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ fix j assume prems': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ with assms(1,2) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
	+ qed auto
	+ qed simp_all
	+qed
	+
	+lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
	+ assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> \<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<longleftrightarrow>
	+ f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	+ using
	+ helper_cat_cone_ntcf_vcomp_Comp[OF assms]
	+ helper_cat_cone_Comp_ntcf_vcomp[OF assms]
	+ by (intro iffI; elim conjE; intro conjI) metis+
	+
	+lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
	+ assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	+ and "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	+ and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+proof-
	+ interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	+ from assms(3) have "op_ntcf \<NN>' = op_ntcf (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" by simp
	+ from this assms(2) have op_\<NN>':
	+ "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
	+ have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	+ by
	+ (
	+ rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
	+ OF is_cat_cone_op \<NN>'.is_cat_cone_op,
	+ unfolded cat_op_simps,
	+ OF assms(2) op_\<NN>' assms(4)
	+ ]
	+ )
	+ from this assms(2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	+ )
	+qed
	+
	+lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
	+ assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	+ and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ shows "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	+proof-
	+ interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	+ from assms(2) have \<NN>'j: "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using that
	+ unfolding assms(3)[OF that]
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ have op_\<NN>':
	+ "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	+ by
	+ (
	+ rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
	+ OF is_cat_cone_op \<NN>'.is_cat_cone_op,
	+ unfolded cat_op_simps,
	+ OF assms(2) \<NN>'j,
	+ simplified
	+ ]
	+ )
	+ from assms(2) show "\<NN>' = (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_op_simps op_\<NN>' eq_op_ntcf_iff[symmetric, OF \<NN>'.is_ntcf_axioms]
	+ cs_intro: cat_cs_intros
	+ )
	+qed
	+
	+lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
	+ assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> \<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<longleftrightarrow>
	+ f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	+ using
	+ helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
	+ helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
	+ by (intro iffI; elim conjE; intro conjI) metis+
	+
	+
	+subsubsection\<open>Vertical composition of a natural transformation and a cone\<close>
	+
	+lemma ntcf_vcomp_is_cat_cone[cat_cs_intros]:
	+ assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<NN> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ intro is_cat_coneI ntcf_vcomp_is_ntcf, rule assms(1);
	+ rule is_cat_coneD[OF assms(2)]
	+ )
	+
	+
	+subsubsection\<open>
	+Composition of a functor and a cone, composition of a functor and a cocone
	+\<close>
	+
	+lemma cf_ntcf_comp_cf_cat_cone:
	+ assumes "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<NN>: is_cat_cone \<alpha> c \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+ show ?thesis
	+ by (intro is_cat_coneI)
	+ (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )+
	+qed
	+
	+lemma cf_ntcf_comp_cf_cat_cone'[cat_cs_intros]:
	+ assumes "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and "\<GG>\<FF> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG>\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ using assms(1,2) unfolding assms(3,4) by (rule cf_ntcf_comp_cf_cat_cone)
	+
	+lemma cf_ntcf_comp_cf_cat_cocone:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<NN>: is_cat_cocone \<alpha> c \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_cone.is_cat_cocone_op
	+ [
	+ OF cf_ntcf_comp_cf_cat_cone[
	+ OF \<NN>.is_cat_cone_op \<GG>.is_functor_op, unfolded cat_op_simps
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+lemma cf_ntcf_comp_cf_cat_cocone'[cat_cs_intros]:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and "\<GG>\<FF> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG>\<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ using assms(1,2) unfolding assms(3,4) by (rule cf_ntcf_comp_cf_cat_cocone)
	+
	+
	+subsubsection\<open>Cones, cocones and constant natural transformations\<close>
	+
	+lemma ntcf_vcomp_ntcf_const_is_cat_cone:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> f : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof-
	+ interpret \<NN>: is_cat_cone \<alpha> b \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ from assms(2) show ?thesis
	+ by (intro is_cat_coneI) (cs_concl cs_intro: cat_cs_intros)
	+qed
	+
	+lemma ntcf_vcomp_ntcf_const_is_cat_cone'[cat_cs_intros]:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> = ntcf_const \<AA> \<BB> f"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ using assms(1,3) unfolding assms(2) by (rule ntcf_vcomp_ntcf_const_is_cat_cone)
	+
	+lemma ntcf_vcomp_ntcf_const_is_cat_cocone:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "ntcf_const \<AA> \<BB> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof-
	+ interpret \<NN>: is_cat_cocone \<alpha> a \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ from is_cat_cone.is_cat_cocone_op
	+ [
	+ OF ntcf_vcomp_ntcf_const_is_cat_cone[
	+ OF \<NN>.is_cat_cone_op, unfolded cat_op_simps, OF assms(2)
	+ ],
	+ unfolded cat_op_simps,
	+ folded op_ntcf_ntcf_const
	+ ]
	+ assms(2)
	+ show ?thesis
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
	+qed
	+
	+lemma ntcf_vcomp_ntcf_const_is_cat_cocone'[cat_cs_intros]:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> = ntcf_const \<AA> \<BB> f"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ using assms(1,3)
	+ unfolding assms(2)
	+ by (rule ntcf_vcomp_ntcf_const_is_cat_cocone)
	+
	+lemma ntcf_vcomp_ntcf_const_CId:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) = \<NN>"
	+proof-
	+
	+ interpret \<NN>: is_cat_cone \<alpha> b \<AA> \<BB> \<FF> \<NN> by (rule assms)
	+
	+ show ?thesis
	+ proof(rule ntcf_eqI)
	+
	+ from \<NN>.cat_cone_obj show lhs_is_ntcf:
	+ "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) :
	+ cf_const \<AA> \<BB> b \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_lhs:
	+ "\<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>))\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ by (simp add: cat_cs_simps)
	+
	+ from \<NN>.cat_cone_obj show "\<NN> : cf_const \<AA> \<BB> b \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ by (simp add: cat_cs_simps)
	+
	+ show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>))\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ from prems \<NN>.cat_cone_obj show
	+ "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use lhs_is_ntcf in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	+
	+ qed simp_all
	+
	+qed
	+
	+lemma ntcf_vcomp_ntcf_const_CId'[cat_cs_simps]:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB>' = \<BB>"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> (\<BB>'\<lparr>CId\<rparr>\<lparr>b\<rparr>) = \<NN>"
	+ using assms(1) unfolding assms(2) by (rule ntcf_vcomp_ntcf_const_CId)
	+
	+
	+
	+subsection\<open>Cone and cocone functors\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>See Chapter V-1 in \cite{mac_lane_categories_2010}.\<close>
	+
	+definition cf_Cone :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	+ where "cf_Cone \<alpha> \<beta> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F
	+ op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
	+
	+definition cf_Cocone :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	+ where "cf_Cocone \<alpha> \<beta> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(cf_map \<FF>,-) \<circ>\<^sub>C\<^sub>F
	+ (\<Delta>\<^sub>C\<^sub>F \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
	+
	+
	+text\<open>An alternative form of the definition.\<close>
	+
	+context is_functor
	+begin
	+
	+lemma cf_Cone_def':
	+ "cf_Cone \<alpha> \<beta> \<FF> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)"
	+ unfolding cf_Cone_def cat_cs_simps by simp
	+
	+lemma cf_Cocone_def':
	+ "cf_Cocone \<alpha> \<beta> \<FF> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(cf_map \<FF>,-) \<circ>\<^sub>C\<^sub>F (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)"
	+ unfolding cf_Cocone_def cat_cs_simps by simp
	+
	+end
	+
	+
	+subsubsection\<open>Object map\<close>
	+
	+lemma (in is_functor) cf_Cone_ObjMap_vsv[cat_cs_intros]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>)"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_intros] = is_functor.cf_Cone_ObjMap_vsv
	+
	+lemma (in is_functor) cf_Cocone_ObjMap_vsv[cat_cs_intros]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "vsv (cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>)"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_intros] = is_functor.cf_Cocone_ObjMap_vsv
	+
	+lemma (in is_functor) cf_Cone_ObjMap_vdomain[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms show ?thesis
	+ unfolding cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cone_ObjMap_vdomain
	+
	+lemma (in is_functor) cf_Cocone_ObjMap_vdomain[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cocone_ObjMap_vdomain
	+
	+lemma (in is_functor) cf_Cone_ObjMap_app[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
	+ Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map (cf_const \<AA> \<BB> b)) (cf_map \<FF>)"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2,3) show ?thesis
	+ unfolding cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cone_ObjMap_app
	+
	+lemma (in is_functor) cf_Cocone_ObjMap_app[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
	+ Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map (cf_const \<AA> \<BB> b))"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2,3) show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cocone_ObjMap_app
	+
	+
	+subsubsection\<open>Arrow map\<close>
	+
	+lemma (in is_functor) cf_Cone_ArrMap_vsv[cat_cs_intros]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>)"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_intros] = is_functor.cf_Cone_ArrMap_vsv
	+
	+lemma (in is_functor) cf_Cocone_ArrMap_vsv[cat_cs_intros]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "vsv (cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>)"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_intros] = is_functor.cf_Cocone_ArrMap_vsv
	+
	+lemma (in is_functor) cf_Cone_ArrMap_vdomain[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cone_ArrMap_vdomain
	+
	+lemma (in is_functor) cf_Cocone_ArrMap_vdomain[cat_cs_simps]:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2) show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cocone_ArrMap_vdomain
	+
	+lemma (in is_functor) cf_Cone_ArrMap_app[cat_cs_simps]:
	+ assumes "\<Z> \<beta>"
	+ and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
	+ (cat_FUNCT \<alpha> \<AA> \<BB>)
	+ [ntcf_arrow (ntcf_const \<AA> \<BB> f), cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>]\<^sub>\<circ>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2,3) show ?thesis
	+ unfolding cf_Cone_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cone_ArrMap_app
	+
	+lemma (in is_functor) cf_Cocone_ArrMap_app[cat_cs_simps]:
	+ assumes "\<Z> \<beta>"
	+ and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "cf_Cocone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
	+ (cat_FUNCT \<alpha> \<AA> \<BB>)
	+ [cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>, ntcf_arrow (ntcf_const \<AA> \<BB> f)]\<^sub>\<circ>"
	+proof-
	+ from assms interpret \<beta>: \<Z> \<beta> by simp
	+ from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ from assms(2,3) show ?thesis
	+ unfolding cf_Cocone_def'
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_functor.cf_Cocone_ArrMap_app
	+
	+
	+subsubsection\<open>The cone functor is a functor\<close>
	+
	+lemma (in is_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+proof-
	+ from assms interpret FUNCT: category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close>
	+ by
	+ (
	+ cs_concl cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from assms interpret op_\<Delta>:
	+ is_functor \<beta> \<open>op_cat \<BB>\<close> \<open>op_cat (cat_FUNCT \<alpha> \<AA> \<BB>)\<close> \<open>op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) :
	+ op_cat (cat_FUNCT \<alpha> \<AA> \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ then show "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+ unfolding cf_Cone_def' by (cs_concl cs_intro: cat_cs_intros)
	+qed
	+
	+lemma (in is_functor) tm_cf_cf_Cocone_is_functor_if_ge_Limit:
	+ assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ shows "cf_Cocone \<alpha> \<beta> \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+proof-
	+ from assms interpret Funct: category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close>
	+ by
	+ (
	+ cs_concl cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from assms interpret op_\<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	+ have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(cf_map \<FF>,-) :
	+ cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ then show "cf_Cocone \<alpha> \<beta> \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	+ unfolding cf_Cocone_def' by (cs_concl cs_intro: cat_cs_intros)
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_FUNCT.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_FUNCT.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_FUNCT.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_FUNCT.thy
	@@ -1,3012 +1,3016 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>FUNCT\<close> and \<open>Funct\<close>\<close>
	theory CZH_ECAT_FUNCT
	imports
	CZH_SMC_FUNCT
	CZH_ECAT_Subcategory
	CZH_ECAT_NTCF
	begin



	subsection\<open>Background\<close>


	text\<open>
	The subsection presents the theory of the categories of \<open>\<alpha>\<close>-functors
	between two \<open>\<alpha>\<close>-categories.
	It continues the development that was initiated in sections
	\ref{sec:dg_FUNCT} and \ref{sec:smc_FUNCT}.
	A general reference for this section is Chapter II-4 in
	\cite{mac_lane_categories_2010}.
	\<close>

	named_theorems cat_FUNCT_cs_simps
	named_theorems cat_FUNCT_cs_intros

	+lemmas (in is_functor) [cat_FUNCT_cs_simps] = cat_map_cs_simps
	+lemmas (in is_functor) [cat_FUNCT_cs_intros] = cat_map_cs_intros
	+
	lemmas [cat_FUNCT_cs_simps] = cat_map_cs_simps
	lemmas [cat_FUNCT_cs_intros] = cat_map_cs_intros



	subsection\<open>\<open>FUNCT\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_FUNCT :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cat_FUNCT \<alpha> \<AA> \<BB> =
	[
	cf_maps \<alpha> \<AA> \<BB>,
	ntcf_arrows \<alpha> \<AA> \<BB>,
	(\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>),
	(\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>),
	(\<lambda>\<MM>\<NN>\<in>\<^sub>\<circ>composable_arrs (dg_FUNCT \<alpha> \<AA> \<BB>). \<MM>\<NN>\<lparr>0\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> \<MM>\<NN>\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>cf_maps \<alpha> \<AA> \<BB>. ntcf_arrow_id \<AA> \<BB> \<FF>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_FUNCT_components:
	shows [cat_FUNCT_cs_simps]: "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> = cf_maps \<alpha> \<AA> \<BB>"
	and "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr> = ntcf_arrows \<alpha> \<AA> \<BB>"
	and "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>)"
	and "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)"
	and "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Comp\<rparr> =
	(\<lambda>\<MM>\<NN>\<in>\<^sub>\<circ>composable_arrs (dg_FUNCT \<alpha> \<AA> \<BB>). \<MM>\<NN>\<lparr>0\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> \<MM>\<NN>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>cf_maps \<alpha> \<AA> \<BB>. ntcf_arrow_id \<AA> \<BB> \<FF>)"
	unfolding cat_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_FUNCT: "cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>) = smc_FUNCT \<alpha> \<AA> \<BB>"
	proof(rule vsv_eqI)
	show "vsv (cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>))" unfolding cat_smc_def by auto
	show "vsv (smc_FUNCT \<alpha> \<AA> \<BB>)" unfolding smc_FUNCT_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_FUNCT \<alpha> \<AA> \<BB>) = 5\<^sub>\<nat>"
	unfolding smc_FUNCT_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>)) = \<D>\<^sub>\<circ> (smc_FUNCT \<alpha> \<AA> \<BB>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>)) \<Longrightarrow>
	cat_smc (cat_FUNCT \<alpha> \<AA> \<BB>)\<lparr>a\<rparr> = smc_FUNCT \<alpha> \<AA> \<BB>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_FUNCT_def smc_FUNCT_def
	)
	(auto simp: nat_omega_simps)
	qed

	context is_ntcf
	begin

	lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
	cat_FUNCT_Dom_app = smc_FUNCT_Dom_app
	and cat_FUNCT_Cod_app = smc_FUNCT_Cod_app

	end

	lemmas [smc_FUNCT_cs_simps] =
	is_ntcf.cat_FUNCT_Dom_app
	is_ntcf.cat_FUNCT_Cod_app

	lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
	cat_FUNCT_Dom_vsv[intro] = smc_FUNCT_Dom_vsv
	and cat_FUNCT_Dom_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Dom_vdomain
	and cat_FUNCT_Cod_vsv[intro] = smc_FUNCT_Cod_vsv
	and cat_FUNCT_Cod_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Cod_vdomain
	and cat_FUNCT_Dom_vrange = smc_FUNCT_Dom_vrange
	and cat_FUNCT_Cod_vrange = smc_FUNCT_Cod_vrange
	and cat_FUNCT_is_arrI = smc_FUNCT_is_arrI
	and cat_FUNCT_is_arrI'[cat_FUNCT_cs_intros] = smc_FUNCT_is_arrI'
	and cat_FUNCT_is_arrD = smc_FUNCT_is_arrD
	and cat_FUNCT_is_arrE[elim] = smc_FUNCT_is_arrE

	lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
	cat_FUNCT_Comp_app[cat_FUNCT_cs_simps] = smc_FUNCT_Comp_app


	subsubsection\<open>Identity\<close>

	mk_VLambda cat_FUNCT_components(6)
	\|vsv cat_FUNCT_CId_vsv[cat_FUNCT_cs_intros]\|
	\|vdomain cat_FUNCT_CId_vdomain[cat_FUNCT_cs_simps]\|
	\|app cat_FUNCT_CId_app[cat_FUNCT_cs_simps]\|

	lemma smc_FUNCT_CId_vrange: "\<R>\<^sub>\<circ> (cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	unfolding cat_FUNCT_components
	proof(rule vrange_VLambda_vsubset)
	fix x assume "x \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<FF> where x_def: "x = cf_map \<FF>" and \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then show "ntcf_arrow_id \<AA> \<BB> x \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	unfolding x_def
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed



	subsubsection\<open>
	The conversion of a natural transformation arrow
	to a natural transformation is a bijection
	\<close>

	lemma bij_betw_ntcf_of_ntcf_arrow:
	"bij_betw
	(ntcf_of_ntcf_arrow \<AA> \<BB>)
	(elts (ntcf_arrows \<alpha> \<AA> \<BB>))
	(elts (ntcfs \<alpha> \<AA> \<BB>))"
	proof(intro bij_betw_imageI inj_onI subset_antisym subsetI)
	fix \<MM> \<NN> assume prems:
	"\<MM> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	"\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	"ntcf_of_ntcf_arrow \<AA> \<BB> \<MM> = ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>"
	from prems(1) obtain \<MM>' \<FF> \<GG>
	where \<MM>_def: "\<MM> = ntcf_arrow \<MM>'" and \<MM>': "\<MM>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from prems(2) obtain \<NN>' \<FF>' \<GG>'
	where \<NN>_def: "\<NN> = ntcf_arrow \<NN>'" and \<NN>': "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from prems(3) have "\<MM>' = \<NN>'"
	unfolding
	\<MM>_def
	\<NN>_def
	is_ntcf.ntcf_of_ntcf_arrow[OF \<MM>']
	is_ntcf.ntcf_of_ntcf_arrow[OF \<NN>']
	by simp
	then show "\<MM> = \<NN>" unfolding \<MM>_def \<NN>_def by auto
	next
	fix \<MM> assume
	"\<MM> \<in> ntcf_of_ntcf_arrow \<AA> \<BB> ` elts (ntcf_arrows \<alpha> \<AA> \<BB>)"
	then obtain \<MM>' where \<MM>': "\<MM>' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	and \<MM>_def: "\<MM> = ntcf_of_ntcf_arrow \<AA> \<BB> \<MM>'"
	by auto
	from \<MM>' obtain \<MM>'' \<FF> \<GG>
	where \<MM>'_def: "\<MM>' = ntcf_arrow \<MM>''"
	and \<MM>'': "\<MM>'' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<MM>'' show "\<MM> \<in>\<^sub>\<circ> ntcfs \<alpha> \<AA> \<BB>"
	unfolding \<MM>_def \<MM>'_def is_ntcf.ntcf_of_ntcf_arrow[OF \<MM>''] by auto
	next
	fix \<MM> assume "\<MM> \<in>\<^sub>\<circ> ntcfs \<alpha> \<AA> \<BB>"
	then obtain \<FF> \<GG> where \<MM>: "\<MM> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
	then have "\<MM> = ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<MM>)"
	by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	moreover from \<MM> have "ntcf_arrow \<MM> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	by (cs_concl cs_intro: cat_FUNCT_cs_intros)
	ultimately show "\<MM> \<in> ntcf_of_ntcf_arrow \<AA> \<BB> ` elts (ntcf_arrows \<alpha> \<AA> \<BB>)"
	by simp
	qed

	lemma bij_betw_ntcf_of_ntcf_arrow_Hom:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "bij_betw
	(ntcf_of_ntcf_arrow \<AA> \<BB>)
	(elts (Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map \<GG>)))
	(elts (these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG>))"
	proof-

	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(2))

	from assms have [cat_cs_simps]:
	"cf_of_cf_map \<AA> \<BB> (cf_map \<FF>) = \<FF>"
	"cf_of_cf_map \<AA> \<BB> (cf_map \<GG>) = \<GG>"
	by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)+

	show ?thesis
	proof
	(
	rule bij_betw_subset[OF bij_betw_ntcf_of_ntcf_arrow];
	(intro subset_antisym subsetI)?;
	(unfold in_Hom_iff)?
	)
	fix \<NN> assume prems: "\<NN> : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	note \<NN> = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
	from \<NN>(1) show "\<NN> \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	by (subst \<NN>(2)) (cs_concl cs_intro: cat_FUNCT_cs_intros)
	next
	fix \<NN> assume
	"\<NN> \<in> ntcf_of_ntcf_arrow \<AA> \<BB> `
	elts (Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map \<GG>))"
	then obtain \<NN>'
	where \<NN>': "\<NN>' \<in>\<^sub>\<circ> Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map \<GG>)"
	and \<NN>_def: "\<NN> = ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>'"
	by auto
	note \<NN>' = cat_FUNCT_is_arrD[
	OF \<NN>'[unfolded cat_cs_simps], unfolded cat_cs_simps
	]
	from \<NN>'(1) show "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG>" unfolding \<NN>_def by simp
	next
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG>"
	then have \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by simp
	then have "\<NN> = ntcf_of_ntcf_arrow \<AA> \<BB> (ntcf_arrow \<NN>)"
	by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	moreover from \<NN> have
	"ntcf_arrow \<NN> \<in>\<^sub>\<circ> Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map \<GG>)"
	unfolding in_Hom_iff by (cs_concl cs_shallow cs_intro: cat_FUNCT_cs_intros)
	ultimately show
	"\<NN> \<in> ntcf_of_ntcf_arrow \<AA> \<BB> `
	elts (Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map \<GG>))"
	by simp
	qed

	qed


	subsubsection\<open>\<open>FUNCT\<close> is a category\<close>

	lemma (in \<Z>) tiny_category_cat_FUNCT[cat_FUNCT_cs_intros]:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_category \<beta> (cat_FUNCT \<alpha> \<AA> \<BB>)" (is \<open>tiny_category \<beta> ?FUNCT\<close>)
	proof(intro tiny_categoryI)
	show "vfsequence ?FUNCT" unfolding cat_FUNCT_def by auto
	show "vcard ?FUNCT = 6\<^sub>\<nat>"
	unfolding cat_FUNCT_def by (simp add: nat_omega_simps)
	from assms show "tiny_semicategory \<beta> (cat_smc ?FUNCT)"
	unfolding cat_smc_FUNCT
	by (auto simp add: tiny_semicategory_smc_FUNCT)
	show CId_a: "?FUNCT\<lparr>CId\<rparr>\<lparr>\<FF>'\<rparr> : \<FF>' \<mapsto>\<^bsub>?FUNCT\<^esub> \<FF>'" if "\<FF>' \<in>\<^sub>\<circ> ?FUNCT\<lparr>Obj\<rparr>" for \<FF>'
	proof-
	from that obtain \<FF> where \<FF>'_def: "\<FF>' = cf_map \<FF>" and \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding cat_FUNCT_components by clarsimp
	show ?thesis
	using that \<FF>
	unfolding cat_FUNCT_components(1) \<FF>'_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show "?FUNCT\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> \<NN> = \<NN>" if "\<NN> : \<FF> \<mapsto>\<^bsub>?FUNCT\<^esub> \<GG>" for \<NN> \<FF> \<GG>
	proof-
	from that obtain \<NN>' \<FF>' \<GG>'
	where \<NN>': "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and \<NN>_def[cat_FUNCT_cs_simps]: "\<NN> = ntcf_arrow \<NN>'"
	and \<FF>_def[cat_FUNCT_cs_simps]: "\<FF> = cf_map \<FF>'"
	and \<GG>_def[cat_FUNCT_cs_simps]: "\<GG> = cf_map \<GG>'"
	by auto
	from \<NN>' show "cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<NN> = \<NN>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show "\<NN> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> ?FUNCT\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> = \<NN>" if "\<NN> : \<GG> \<mapsto>\<^bsub>?FUNCT\<^esub> \<HH>" for \<NN> \<GG> \<HH>
	proof-
	note \<NN> = cat_FUNCT_is_arrD[OF that]
	from \<NN>(1) show "\<NN> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> = \<NN>"
	by (subst (1 2) \<NN>(2), subst \<NN>(3), remdups)
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	qed (simp_all add: assms cat_FUNCT_components)

	lemmas (in \<Z>) [cat_FUNCT_cs_intros] = tiny_category_cat_FUNCT



	subsubsection\<open>Isomorphism\<close>

	-lemma (in \<Z>) cat_FUNCT_is_arr_isomorphismI:
	+lemma cat_FUNCT_is_iso_arrI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	interpret \<NN>: is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms)
	show is_arr_\<NN>: "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	by (simp add: assms cat_FUNCT_is_arrI is_iso_ntcf.axioms(1))
	interpret inv_\<NN>: is_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close>
	- using CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF assms] by simp
	+ using CZH_ECAT_NTCF.iso_ntcf_is_iso_arr(1)[OF assms] by simp
	from assms show is_arr_inv_\<NN>:
	"ntcf_arrow (inv_ntcf \<NN>) : cf_map \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<FF>"
	by
	(
	cs_concl cs_shallow cs_intro:
	ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from assms show "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms show
	"ntcf_arrow (inv_ntcf \<NN>) \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> ntcf_arrow \<NN> =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>"
	"ntcf_arrow \<NN> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> ntcf_arrow (inv_ntcf \<NN>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<GG>\<rparr>"
	by
	(
	cs_concl cs_shallow
	- cs_simp: iso_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
	+ cs_simp: iso_ntcf_is_iso_arr(2,3) cat_FUNCT_cs_simps
	cs_intro: ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+
	qed

	-lemma (in \<Z>) cat_FUNCT_is_arr_isomorphismI':
	- assumes "\<NN>' = ntcf_arrow \<NN>"
	- and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+lemma cat_FUNCT_is_iso_arrI'[cat_FUNCT_cs_intros]:
	+ assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<NN>' = ntcf_arrow \<NN>"
	and "\<FF>' = cf_map \<FF>"
	and "\<GG>' = cf_map \<GG>"
	shows "\<NN>' : \<FF>' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	- using assms(2) unfolding assms(1,3,4) by (rule cat_FUNCT_is_arr_isomorphismI)
	-
	-lemmas [cat_FUNCT_cs_intros] = \<Z>.cat_FUNCT_is_arr_isomorphismI'[rotated 2]
	-
	-lemma (in \<Z>) cat_FUNCT_is_arr_isomorphismD:
	+ using assms(1) unfolding assms(2-4) by (rule cat_FUNCT_is_iso_arrI)
	+
	+lemma cat_FUNCT_is_iso_arrD:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>" (is \<open>\<NN> : \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>?FUNCT\<^esub> \<GG>\<close>)
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	proof-
	+ from assms(1) have \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	+ unfolding is_iso_arr_def by simp
	+ interpret \<Z> \<alpha> by (rule is_ntcfD[OF cat_FUNCT_is_arrD(1)[OF \<NN>]])
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<Z>\<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<Z>_\<alpha>_\<alpha>\<omega> \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<beta>_def)
	interpret FUNCT: tiny_category \<beta> ?FUNCT
	by (rule tiny_category_cat_FUNCT[OF \<Z>\<beta> \<alpha>\<beta>, of \<AA> \<BB>])
	have inv_\<NN>: "\<NN>\<inverse>\<^sub>C\<^bsub>?FUNCT\<^esub> : \<GG> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>?FUNCT\<^esub> \<FF>"
	and inv_\<NN>_\<NN>: "\<NN>\<inverse>\<^sub>C\<^bsub>?FUNCT\<^esub> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> \<NN> = ?FUNCT\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>"
	and \<NN>_inv_\<NN>: "\<NN> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> \<NN>\<inverse>\<^sub>C\<^bsub>?FUNCT\<^esub> = ?FUNCT\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr>"
	by
	(
	intro
	- FUNCT.cat_the_inverse_is_arr_isomorphism[OF assms]
	+ FUNCT.cat_the_inverse_is_iso_arr[OF assms]
	FUNCT.cat_the_inverse_Comp_CId[OF assms]
	)+
	- from assms is_arr_isomorphismD inv_\<NN>
	+ from assms is_iso_arrD inv_\<NN>
	have \<NN>_is_arr: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	and inv_\<NN>_is_arr: "\<NN>\<inverse>\<^sub>C\<^bsub>?FUNCT\<^esub> : \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<FF>"
	by auto
	note \<NN>_is_arr = cat_FUNCT_is_arrD[OF \<NN>_is_arr]
	note inv_\<NN>_is_arr = cat_FUNCT_is_arrD[OF inv_\<NN>_is_arr]
	let ?\<NN> = \<open>ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<close>
	and ?inv_\<NN> = \<open>ntcf_of_ntcf_arrow \<AA> \<BB> (\<NN>\<inverse>\<^sub>C\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub>)\<close>
	from inv_\<NN>_\<NN> \<NN>_is_arr(1) inv_\<NN>_is_arr(1) have inv_\<NN>_\<NN>:
	"?inv_\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<NN> = ntcf_id (cf_of_cf_map \<AA> \<BB> \<FF>)"
	by
	(
	subst (asm) inv_\<NN>_is_arr(2),
	use nothing in \<open>subst (asm) (2) \<NN>_is_arr(2), subst (asm) \<NN>_is_arr(3)\<close>
	)
	(
	cs_prems cs_shallow
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_cs_intros
	)
	from \<NN>_inv_\<NN> inv_\<NN>_is_arr(1) \<NN>_is_arr(1) have \<NN>_inv_\<NN>:
	"?\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?inv_\<NN> = ntcf_id (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by
	(
	subst (asm) inv_\<NN>_is_arr(2),
	use nothing in \<open>subst (asm) \<NN>_is_arr(2), subst (asm) \<NN>_is_arr(4)\<close>
	)
	(
	cs_prems cs_shallow
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_cs_intros
	)
	show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	- rule CZH_ECAT_NTCF.is_arr_isomorphism_is_iso_ntcf[
	+ rule CZH_ECAT_NTCF.is_iso_arr_is_iso_ntcf[
	OF \<NN>_is_arr(1) inv_\<NN>_is_arr(1) \<NN>_inv_\<NN> inv_\<NN>_\<NN>
	]
	)
	show "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by (intro \<NN>_is_arr(2-4))+
	qed



	subsection\<open>\<open>Funct\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_Funct :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cat_Funct \<alpha> \<AA> \<BB> =
	[
	tm_cf_maps \<alpha> \<AA> \<BB>,
	tm_ntcf_arrows \<alpha> \<AA> \<BB>,
	(\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>),
	(\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>),
	(\<lambda>\<MM>\<NN>\<in>\<^sub>\<circ>composable_arrs (dg_Funct \<alpha> \<AA> \<BB>). \<MM>\<NN>\<lparr>0\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> \<MM>\<NN>\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>tm_cf_maps \<alpha> \<AA> \<BB>. ntcf_arrow_id \<AA> \<BB> \<FF>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_Funct_components:
	- shows "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> = tm_cf_maps \<alpha> \<AA> \<BB>"
	+ shows [cat_FUNCT_cs_simps]: "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr> = tm_cf_maps \<alpha> \<AA> \<BB>"
	and "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr> = tm_ntcf_arrows \<alpha> \<AA> \<BB>"
	and "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Dom\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTDom\<rparr>)"
	and "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Cod\<rparr> = (\<lambda>\<NN>\<in>\<^sub>\<circ>tm_ntcf_arrows \<alpha> \<AA> \<BB>. \<NN>\<lparr>NTCod\<rparr>)"
	and "cat_Funct \<alpha> \<AA> \<BB>\<lparr>Comp\<rparr> =
	(\<lambda>\<MM>\<NN>\<in>\<^sub>\<circ>composable_arrs (dg_Funct \<alpha> \<AA> \<BB>). \<MM>\<NN>\<lparr>0\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^bsub>\<AA>,\<BB>\<^esub> \<MM>\<NN>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>tm_cf_maps \<alpha> \<AA> \<BB>. ntcf_arrow_id \<AA> \<BB> \<FF>)"
	unfolding cat_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_Funct: "cat_smc (cat_Funct \<alpha> \<AA> \<BB>) = smc_Funct \<alpha> \<AA> \<BB>"
	proof(rule vsv_eqI)
	show "vsv (cat_smc (cat_Funct \<alpha> \<AA> \<BB>))" unfolding cat_smc_def by auto
	show "vsv (smc_Funct \<alpha> \<AA> \<BB>)" unfolding smc_Funct_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_Funct \<alpha> \<AA> \<BB>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_Funct \<alpha> \<AA> \<BB>) = 5\<^sub>\<nat>"
	unfolding smc_Funct_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_Funct \<alpha> \<AA> \<BB>)) = \<D>\<^sub>\<circ> (smc_Funct \<alpha> \<AA> \<BB>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_Funct \<alpha> \<AA> \<BB>)) \<Longrightarrow>
	cat_smc (cat_Funct \<alpha> \<AA> \<BB>)\<lparr>a\<rparr> = smc_Funct \<alpha> \<AA> \<BB>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_Funct_def smc_Funct_def
	)
	(auto simp: nat_omega_simps)
	qed

	context is_tm_ntcf
	begin

	lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
	cat_Funct_Dom_app = smc_Funct_Dom_app
	and cat_Funct_Cod_app = smc_Funct_Cod_app

	end

	lemmas [cat_FUNCT_cs_simps] =
	is_tm_ntcf.cat_Funct_Dom_app
	is_tm_ntcf.cat_Funct_Cod_app

	lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
	cat_Funct_Dom_vsv[cat_FUNCT_cs_intros] = smc_Funct_Dom_vsv
	and cat_Funct_Dom_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Dom_vdomain
	and cat_Funct_Cod_vsv[cat_FUNCT_cs_intros] = smc_Funct_Cod_vsv
	and cat_Funct_Cod_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Cod_vdomain
	and cat_Funct_Dom_vrange = smc_Funct_Dom_vrange
	and cat_Funct_Cod_vrange = smc_Funct_Cod_vrange
	and cat_Funct_is_arrI = smc_Funct_is_arrI
	and cat_Funct_is_arrI'[cat_FUNCT_cs_intros] = smc_Funct_is_arrI'
	and cat_Funct_is_arrD = smc_Funct_is_arrD
	and cat_Funct_is_arrE[elim] = smc_Funct_is_arrE

	lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
	cat_Funct_Comp_app[cat_FUNCT_cs_simps] = smc_Funct_Comp_app


	subsubsection\<open>Identity\<close>

	mk_VLambda cat_Funct_components(6)
	\|vsv cat_Funct_CId_vsv[intro]\|
	\|vdomain cat_Funct_CId_vdomain[cat_FUNCT_cs_simps]\|
	\|app cat_Funct_CId_app[cat_FUNCT_cs_simps]\|

	lemma smc_Funct_CId_vrange: "\<R>\<^sub>\<circ> (cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	unfolding cat_Funct_components
	proof(rule vrange_VLambda_vsubset)
	fix \<FF>' assume "\<FF>' \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<FF> where \<FF>'_def: "\<FF>' = cf_map \<FF>" and \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then show "ntcf_arrow_id \<AA> \<BB> \<FF>' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<AA> \<BB>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps \<FF>'_def
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	qed


	subsubsection\<open>\<open>Funct\<close> is a category\<close>

	lemma category_cat_Funct:
	assumes "tiny_category \<alpha> \<AA>" and "category \<alpha> \<BB>"
	shows "category \<alpha> (cat_Funct \<alpha> \<AA> \<BB>)" (is \<open>category \<alpha> ?Funct\<close>)
	proof-
	interpret tiny_category \<alpha> \<AA> by (rule assms(1))
	show ?thesis
	proof(intro categoryI)
	show "vfsequence ?Funct" by (simp add: cat_Funct_def)
	show "vcard ?Funct = 6\<^sub>\<nat>"
	unfolding cat_Funct_def by (simp add: nat_omega_simps)
	from assms show "semicategory \<alpha> (cat_smc (cat_Funct \<alpha> \<AA> \<BB>))"
	unfolding cat_smc_Funct by (rule semicategory_smc_Funct)
	show "\<D>\<^sub>\<circ> (cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>) = cat_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_Funct_components cat_FUNCT_cs_simps)
	show "cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr> : \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<FF>"
	if "\<FF> \<in>\<^sub>\<circ> cat_Funct \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" for \<FF>
	proof-
	from that have "\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>"
	unfolding cat_Funct_components by simp
	then obtain \<FF>'
	where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from assms \<FF>' show "cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr> : \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<FF>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps \<FF>_def
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	qed
	show "cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<NN> = \<NN>"
	if "\<NN> : \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>" for \<FF> \<GG> \<NN>
	proof-
	note \<NN> = cat_Funct_is_arrD[OF that]
	from assms \<NN>(1) show
	"cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<NN> = \<NN>"
	by (subst (1 2) \<NN>(2), use nothing in \<open>subst \<NN>(4)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	qed
	show "\<NN> \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> = \<NN>"
	if "\<NN> : \<GG> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<HH>" for \<GG> \<HH> \<NN>
	proof-
	note \<NN> = cat_Funct_is_arrD[OF that]
	from assms \<NN>(1) show
	"\<NN> \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr> = \<NN>"
	by (subst (1 2) \<NN>(2), use nothing in \<open>subst \<NN>(3)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	qed
	qed auto
	qed

	lemma category_cat_Funct'[cat_FUNCT_cs_intros]:
	assumes "tiny_category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<beta> = \<alpha>"
	shows "category \<alpha> (cat_Funct \<beta> \<AA> \<BB>)"
	using assms(1,2) unfolding assms(3) by (rule category_cat_Funct)


	subsubsection\<open>\<open>Funct\<close> is a subcategory of \<open>FUNCT\<close>\<close>

	lemma subcategory_cat_Funct_cat_FUNCT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "tiny_category \<alpha> \<AA>" and "category \<alpha> \<BB>"
	shows "cat_Funct \<alpha> \<AA> \<BB> \<subseteq>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<BB>"
	proof
	(
	intro subcategoryI,
	unfold cat_smc_FUNCT cat_smc_Funct cat_Funct_components(1)
	)
	interpret category \<alpha> \<BB> by (rule assms(4))
	interpret \<AA>\<BB>: category \<alpha> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close>
	by (rule category_cat_Funct[OF assms(3,4)])
	show "category \<beta> (cat_Funct \<alpha> \<AA> \<BB>)"
	by (rule category.cat_category_if_ge_Limit[OF _ assms(1,2)])
	(auto intro: cat_cs_intros)
	from assms show "category \<beta> (cat_FUNCT \<alpha> \<AA> \<BB>)"
	by (cs_concl cs_intro: tiny_category_cat_FUNCT cat_small_cs_intros)
	show "smc_Funct \<alpha> \<AA> \<BB> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> smc_FUNCT \<alpha> \<AA> \<BB>"
	by (rule subsemicategory_smc_Funct_smc_FUNCT[OF assms])
	show "cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr> = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>"
	if \<open>\<FF> \<in>\<^sub>\<circ> tm_cf_maps \<alpha> \<AA> \<BB>\<close> for \<FF>
	proof-
	from that obtain \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'"
	and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros tm_cf_maps_in_cf_maps
	)
	qed
	qed


	subsubsection\<open>Isomorphism\<close>

	-lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI:
	+lemma (in is_tm_iso_ntcf) cat_Funct_is_iso_arrI:
	assumes "category \<alpha> \<BB>"
	shows "ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	from is_tm_iso_ntcf_axioms show
	"ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	by (cs_concl cs_shallow cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
	interpret inv_\<NN>: is_tm_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close>
	- by (rule iso_tm_ntcf_is_arr_isomorphism(1)[OF assms is_tm_iso_ntcf_axioms])
	+ by (rule iso_tm_ntcf_is_iso_arr(1)[OF assms is_tm_iso_ntcf_axioms])
	from inv_\<NN>.is_tm_iso_ntcf_axioms show
	"ntcf_arrow (inv_ntcf \<NN>) : cf_map \<GG> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<FF>"
	by (cs_concl cs_shallow cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
	from is_tm_iso_ntcf_axioms show
	"ntcf_arrow \<NN> : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	by (cs_concl cs_shallow cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
	from assms is_tm_iso_ntcf_axioms show
	"ntcf_arrow (inv_ntcf \<NN>) \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> ntcf_arrow \<NN> =
	cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>"
	"ntcf_arrow \<NN> \<circ>\<^sub>A\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> ntcf_arrow (inv_ntcf \<NN>) =
	cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<GG>\<rparr>"
	by
	(
	cs_concl
	- cs_simp: iso_tm_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
	+ cs_simp: iso_tm_ntcf_is_iso_arr(2,3) cat_FUNCT_cs_simps
	cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
	)+
	qed

	-lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI':
	+lemma (in is_tm_iso_ntcf) cat_Funct_is_iso_arrI':
	assumes "category \<alpha> \<BB>"
	and "\<NN>' = ntcf_arrow \<NN>"
	and "\<FF>' = cf_map \<FF>"
	and "\<GG>' = cf_map \<GG>"
	shows "\<NN>' : \<FF>' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> cf_map \<GG>"
	- using assms(1) unfolding assms(2-4) by (rule cat_Funct_is_arr_isomorphismI)
	+ using assms(1) unfolding assms(2-4) by (rule cat_Funct_is_iso_arrI)

	lemmas [cat_FUNCT_cs_intros] =
	- is_tm_iso_ntcf.cat_Funct_is_arr_isomorphismI'[rotated 2]
	-
	-lemma (in \<Z>) cat_Funct_is_arr_isomorphismD:
	+ is_tm_iso_ntcf.cat_Funct_is_iso_arrI'[rotated 2]
	+
	+lemma cat_Funct_is_iso_arrD:
	assumes "tiny_category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>" (is \<open>\<NN> : \<FF> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>?Funct\<^esub> \<GG>\<close>)
	shows "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	proof-
	interpret Funct: category \<alpha> ?Funct
	by (rule category_cat_Funct[OF assms(1,2)])
	have inv_\<NN>: "\<NN>\<inverse>\<^sub>C\<^bsub>?Funct\<^esub> : \<GG> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>?Funct\<^esub> \<FF>"
	and inv_\<NN>_\<NN>: "\<NN>\<inverse>\<^sub>C\<^bsub>?Funct\<^esub> \<circ>\<^sub>A\<^bsub>?Funct\<^esub> \<NN> = ?Funct\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>"
	and \<NN>_inv_\<NN>: "\<NN> \<circ>\<^sub>A\<^bsub>?Funct\<^esub> \<NN>\<inverse>\<^sub>C\<^bsub>?Funct\<^esub> = ?Funct\<lparr>CId\<rparr>\<lparr>\<GG>\<rparr>"
	by
	(
	intro
	- Funct.cat_the_inverse_is_arr_isomorphism[OF assms(3)]
	+ Funct.cat_the_inverse_is_iso_arr[OF assms(3)]
	Funct.cat_the_inverse_Comp_CId[OF assms(3)]
	)+
	- from assms is_arr_isomorphismD inv_\<NN>
	+ from assms is_iso_arrD inv_\<NN>
	have \<NN>_is_arr: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	and inv_\<NN>_is_arr: "\<NN>\<inverse>\<^sub>C\<^bsub>?Funct\<^esub> : \<GG> \<mapsto>\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub> \<FF>"
	by auto
	note \<NN>_is_arr = cat_Funct_is_arrD[OF \<NN>_is_arr]
	note inv_\<NN>_is_arr = cat_Funct_is_arrD[OF inv_\<NN>_is_arr]
	let ?\<NN> = \<open>ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>\<close>
	and ?inv_\<NN> = \<open>ntcf_of_ntcf_arrow \<AA> \<BB> (\<NN>\<inverse>\<^sub>C\<^bsub>cat_Funct \<alpha> \<AA> \<BB>\<^esub>)\<close>
	from inv_\<NN>_\<NN> \<NN>_is_arr(1) inv_\<NN>_is_arr(1) have inv_\<NN>_\<NN>:
	"?inv_\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<NN> = ntcf_id (cf_of_cf_map \<AA> \<BB> \<FF>)"
	by
	(
	subst (asm) inv_\<NN>_is_arr(2),
	use nothing in \<open>subst (asm) (2) \<NN>_is_arr(2), subst (asm) \<NN>_is_arr(3)\<close>
	)
	(
	cs_prems
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	from \<NN>_inv_\<NN> inv_\<NN>_is_arr(1) \<NN>_is_arr(1) have \<NN>_inv_\<NN>:
	"?\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?inv_\<NN> = ntcf_id (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by
	(
	subst (asm) inv_\<NN>_is_arr(2),
	use nothing in \<open>subst (asm) \<NN>_is_arr(2), subst (asm) \<NN>_is_arr(4)\<close>
	)
	(
	cs_prems
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
	)
	show "ntcf_of_ntcf_arrow \<AA> \<BB> \<NN> :
	cf_of_cf_map \<AA> \<BB> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_of_cf_map \<AA> \<BB> \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	- rule is_arr_isomorphism_is_tm_iso_ntcf[
	+ rule is_iso_arr_is_tm_iso_ntcf[
	OF \<NN>_is_arr(1) inv_\<NN>_is_arr(1) \<NN>_inv_\<NN> inv_\<NN>_\<NN>
	]
	)
	show "\<NN> = ntcf_arrow (ntcf_of_ntcf_arrow \<AA> \<BB> \<NN>)"
	and "\<FF> = cf_map (cf_of_cf_map \<AA> \<BB> \<FF>)"
	and "\<GG> = cf_map (cf_of_cf_map \<AA> \<BB> \<GG>)"
	by (intro \<NN>_is_arr(2-4))+
	qed



	subsection\<open>Diagonal functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_diagonal :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>\<Delta>\<^sub>C\<^sub>F\<close>)
	where "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. cf_map (cf_const \<JJ> \<CC> a)),
	(\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. ntcf_arrow (ntcf_const \<JJ> \<CC> f)),
	\<CC>,
	cat_FUNCT \<alpha> \<JJ> \<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_diagonal_components:
	shows "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. cf_map (cf_const \<JJ> \<CC> a))"
	and "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. ntcf_arrow (ntcf_const \<JJ> \<CC> f))"
	and "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>HomDom\<rparr> = \<CC>"
	and "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> \<JJ> \<CC>"
	unfolding cf_diagonal_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda cf_diagonal_components(1)
	\|vsv cf_diagonal_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain cf_diagonal_ObjMap_vdomain[cat_cs_simps]\|
	\|app cf_diagonal_ObjMap_app[cat_cs_simps]\|

	lemma cf_diagonal_ObjMap_vrange:
	assumes "\<Z> \<beta>"and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<JJ>" and "category \<alpha> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<JJ> \<CC>\<lparr>Obj\<rparr>"
	unfolding cf_diagonal_components
	proof(rule vrange_VLambda_vsubset)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret category \<alpha> \<JJ> by (rule assms(3))
	interpret FUNCT: tiny_category \<beta> \<open>(cat_FUNCT \<alpha> \<JJ> \<CC>)\<close>
	by (rule \<Z>.tiny_category_cat_FUNCT[OF \<Z>_axioms assms(1,2)])
	fix x assume prems: "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from prems assms show "cf_map (cf_const \<JJ> \<CC> x) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<JJ> \<CC>\<lparr>Obj\<rparr>"
	unfolding cat_FUNCT_components(1)
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed


	subsubsection\<open>Arrow map\<close>

	mk_VLambda cf_diagonal_components(2)
	\|vsv cf_diagonal_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain cf_diagonal_ArrMap_vdomain[cat_cs_simps]\|
	\|app cf_diagonal_ArrMap_app[cat_cs_simps]\|


	subsubsection\<open>Diagonal functor is a functor\<close>

	lemma cf_diagonal_is_functor[cat_cs_intros]:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<JJ>" and "category \<alpha> \<CC>"
	shows "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>" (is \<open>?\<Delta> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> ?FUNCT\<close>)
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(3))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(4))
	interpret FUNCT: tiny_category \<beta> \<open>(cat_FUNCT \<alpha> \<JJ> \<CC>)\<close>
	by (rule \<Z>.tiny_category_cat_FUNCT[OF \<JJ>.\<Z>_axioms assms(1,2)])

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence ?\<Delta>"
	unfolding cf_diagonal_def by (simp add: nat_omega_simps)
	show "category \<beta> \<CC>" by (rule \<CC>.cat_category_if_ge_Limit[OF assms(1,2)])
	from assms show "category \<beta> (cat_FUNCT \<alpha> \<JJ> \<CC>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "vcard ?\<Delta> = 4\<^sub>\<nat>"
	unfolding cf_diagonal_def by (simp add: nat_omega_simps)
	show "vsv (?\<Delta>\<lparr>ObjMap\<rparr>)" unfolding cf_diagonal_components by simp
	from assms show "\<R>\<^sub>\<circ> (?\<Delta>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ?FUNCT\<lparr>Obj\<rparr>"
	by (rule cf_diagonal_ObjMap_vrange)
	show "?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : ?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>?FUNCT\<^esub> ?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for f a b
	using that
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
	)
	show "?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = ?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> ?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for g b c f a
	using that \<JJ>.category_axioms \<CC>.category_axioms
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with \<JJ>.category_axioms \<CC>.category_axioms show
	"?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = ?FUNCT\<lparr>CId\<rparr>\<lparr>?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (auto simp: cf_diagonal_components cat_smc_FUNCT)

	qed

	lemma cf_diagonal_is_functor'[cat_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "category \<alpha> \<JJ>"
	and "category \<alpha> \<CC>"
	and "\<AA>' = \<CC>"
	and "\<BB>' = cat_FUNCT \<alpha> \<JJ> \<CC>"
	shows "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>'"
	using assms(1-4) unfolding assms(5-6) by (rule cf_diagonal_is_functor)



	(TODO: functor codomain substitution)
	subsection\<open>Diagonal functor for functors with tiny maps\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	definition tm_cf_diagonal :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<close>)
	where "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. cf_map (cf_const \<JJ> \<CC> a)),
	(\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. ntcf_arrow (ntcf_const \<JJ> \<CC> f)),
	\<CC>,
	cat_Funct \<alpha> \<JJ> \<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma tm_cf_diagonal_components:
	shows "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. cf_map (cf_const \<JJ> \<CC> a))"
	and "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. ntcf_arrow (ntcf_const \<JJ> \<CC> f))"
	and "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>HomDom\<rparr> = \<CC>"
	and "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>HomCod\<rparr> = cat_Funct \<alpha> \<JJ> \<CC>"
	unfolding tm_cf_diagonal_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda tm_cf_diagonal_components(1)
	\|vsv tm_cf_diagonal_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain tm_cf_diagonal_ObjMap_vdomain[cat_cs_simps]\|
	\|app tm_cf_diagonal_ObjMap_app[cat_cs_simps]\|

	lemma tm_cf_diagonal_ObjMap_vrange:
	assumes "tiny_category \<alpha> \<JJ>" and "category \<alpha> \<CC>"
	shows "\<R>\<^sub>\<circ> (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Funct \<alpha> \<JJ> \<CC>\<lparr>Obj\<rparr>"
	unfolding tm_cf_diagonal_components
	proof(rule vrange_VLambda_vsubset)
	fix x assume "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms category_cat_Funct[OF assms] show
	"cf_map (cf_const \<JJ> \<CC> x) \<in>\<^sub>\<circ> cat_Funct \<alpha> \<JJ> \<CC>\<lparr>Obj\<rparr>"
	unfolding cat_Funct_components(1)
	by (cs_concl cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
	qed


	subsubsection\<open>Arrow map\<close>

	mk_VLambda tm_cf_diagonal_components(2)
	\|vsv tm_cf_diagonal_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain tm_cf_diagonal_ArrMap_vdomain[cat_cs_simps]\|
	\|app tm_cf_diagonal_ArrMap_app[cat_cs_simps]\|


	subsubsection\<open>Diagonal functor for functors with tiny maps is a functor\<close>

	lemma tm_cf_diagonal_is_functor[cat_cs_intros]:
	assumes "tiny_category \<alpha> \<JJ>" and "category \<alpha> \<CC>"
	shows "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Funct \<alpha> \<JJ> \<CC>"
	(is \<open>?\<Delta> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?Funct\<close>)
	proof-

	interpret \<JJ>: tiny_category \<alpha> \<JJ> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence ?\<Delta>"
	unfolding tm_cf_diagonal_def by (simp add: nat_omega_simps)
	from assms(2) show "category \<alpha> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "category \<alpha> ?Funct"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros category_cat_Funct)
	show "vcard ?\<Delta> = 4\<^sub>\<nat>"
	unfolding tm_cf_diagonal_def by (simp add: nat_omega_simps)
	show "vsv (?\<Delta>\<lparr>ObjMap\<rparr>)" unfolding tm_cf_diagonal_components by simp
	from assms show "\<R>\<^sub>\<circ> (?\<Delta>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ?Funct\<lparr>Obj\<rparr>"
	by (rule tm_cf_diagonal_ObjMap_vrange)
	show "?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : ?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>?Funct\<^esub> ?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for f a b
	using that
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
	)
	show "?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = ?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>?Funct\<^esub> ?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for g b c f a
	using that \<JJ>.category_axioms \<CC>.category_axioms
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with \<JJ>.category_axioms \<CC>.category_axioms show
	"?\<Delta>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = ?Funct\<lparr>CId\<rparr>\<lparr>?\<Delta>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (auto simp: tm_cf_diagonal_components cat_smc_FUNCT)

	qed

	lemma tm_cf_diagonal_is_functor'[cat_cs_intros]:
	assumes "tiny_category \<alpha> \<JJ>"
	and "category \<alpha> \<CC>"
	and "\<alpha>' = \<alpha>"
	and "\<AA> = \<CC>"
	and "\<BB> = cat_Funct \<alpha> \<JJ> \<CC>"
	shows "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>"
	using assms(1-2) unfolding assms(3-5) by (rule tm_cf_diagonal_is_functor)



	subsection\<open>Functor raised to the power of a category\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	Most of the definitions and the results presented in this
	and the remaining subsections
	can be found in \cite{mac_lane_categories_2010} and
	\cite{riehl_category_2016} (e.g., see Chapter X-3
	in \cite{mac_lane_categories_2010}).
	\<close>

	definition exp_cf_cat :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "exp_cf_cat \<alpha> \<KK> \<AA> =
	[
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	cf_map (\<KK> \<circ>\<^sub>C\<^sub>F cf_of_cf_map \<AA> (\<KK>\<lparr>HomDom\<rparr>) \<SS>)
	),
	(
	\<lambda>\<sigma>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_of_ntcf_arrow \<AA> (\<KK>\<lparr>HomDom\<rparr>) \<sigma>)
	),
	cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>),
	cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma exp_cf_cat_components:
	shows "exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	cf_map (\<KK> \<circ>\<^sub>C\<^sub>F cf_of_cf_map \<AA> (\<KK>\<lparr>HomDom\<rparr>) \<SS>)
	)"
	and
	"exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>\<sigma>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_of_ntcf_arrow \<AA> (\<KK>\<lparr>HomDom\<rparr>) \<sigma>))
	)"
	and "exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomDom\<rparr>)"
	and "exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> \<AA> (\<KK>\<lparr>HomCod\<rparr>)"
	unfolding exp_cf_cat_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda exp_cf_cat_components(1)
	\|vsv exp_cf_cat_components_ObjMap_vsv[cat_FUNCT_cs_intros]\|

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda exp_cf_cat_components(1)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	\|vdomain exp_cf_cat_components_ObjMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_cf_cat_components_ObjMap_app[cat_FUNCT_cs_simps]\|

	end


	subsubsection\<open>Arrow map\<close>

	mk_VLambda exp_cf_cat_components(2)
	\|vsv exp_cf_cat_components_ArrMap_vsv[cat_FUNCT_cs_intros]\|

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda exp_cf_cat_components(2)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	\|vdomain exp_cf_cat_components_ArrMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_cf_cat_components_ArrMap_app[cat_FUNCT_cs_simps]\|

	end


	subsubsection\<open>Domain and codomain\<close>

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	lemmas exp_cf_cat_HomDom[cat_FUNCT_cs_simps] =
	exp_cf_cat_components(3)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	and exp_cf_cat_HomCod[cat_FUNCT_cs_simps] =
	exp_cf_cat_components(4)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]

	end


	subsubsection\<open>Functor raised to the power of a category is a functor\<close>

	lemma exp_cf_cat_is_tiny_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<AA>" and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "exp_cf_cat \<alpha> \<KK> \<AA> : cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(3))
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(4))
	from assms(2-4) interpret \<AA>\<BB>: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2-4) interpret \<AA>\<CC>: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<CC>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	show ?thesis
	proof(intro is_tiny_functorI' is_functorI')
	show "vfsequence (exp_cf_cat \<alpha> \<KK> \<AA>)" unfolding exp_cf_cat_def by simp
	show "vcard (exp_cf_cat \<alpha> \<KK> \<AA>) = 4\<^sub>\<nat>"
	unfolding exp_cf_cat_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> \<CC>\<lparr>Obj\<rparr>"
	proof
	(
	unfold cat_FUNCT_components exp_cf_cat_components,
	intro vrange_VLambda_vsubset,
	unfold cat_cs_simps
	)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from assms(2-4) \<FF>' show
	"cf_map (\<KK> \<circ>\<^sub>C\<^sub>F cf_of_cf_map \<AA> \<BB> \<FF>) \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<CC>"
	by (cs_concl cs_simp: \<FF>_def cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed
	show "exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> :
	exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<CC>\<^esub>
	exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<rparr>"
	if "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>" for \<FF> \<GG> \<NN>
	proof-
	note \<NN> = cat_FUNCT_is_arrD[OF that]
	from \<NN>(1,3,4) assms(2-4) show ?thesis
	by (subst \<NN>(2), use nothing in \<open>subst \<NN>(3), subst \<NN>(4)\<close>)
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show
	"exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<MM> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<NN>\<rparr> =
	exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<CC>\<^esub>
	exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	if "\<MM> : \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<HH>" and "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>"
	for \<GG> \<HH> \<MM> \<FF> \<NN>
	proof-
	note \<MM> = cat_FUNCT_is_arrD[OF that(1)]
	and \<NN> = cat_FUNCT_is_arrD[OF that(2)]
	from \<MM>(1,3,4) \<NN>(1,3,4) assms(2-4) show ?thesis
	by (subst (1 2) \<MM>(2), use nothing in \<open>subst (1 2) \<NN>(2)\<close>)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show
	"exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>\<rparr> =
	cat_FUNCT \<alpha> \<AA> \<CC>\<lparr>CId\<rparr>\<lparr>exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr>\<rparr>"
	if "\<FF> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>" for \<FF>
	proof-
	from that[unfolded cat_FUNCT_components] obtain \<GG>
	where \<FF>_def: "\<FF> = cf_map \<GG>" and \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<GG> show
	"exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ArrMap\<rparr>\<lparr>cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>\<rparr> =
	cat_FUNCT \<alpha> \<AA> \<CC>\<lparr>CId\<rparr>\<lparr>exp_cf_cat \<alpha> \<KK> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps \<FF>_def
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	qed
	(
	use assms(1,2) in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	\<close>
	)+
	qed

	lemma exp_cf_cat_is_tiny_functor'[cat_FUNCT_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "category \<alpha> \<AA>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = cat_FUNCT \<alpha> \<AA> \<BB>"
	and "\<BB>' = cat_FUNCT \<alpha> \<AA> \<CC>"
	shows "exp_cf_cat \<alpha> \<KK> \<AA> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>'"
	using assms(1-4) unfolding assms(5,6) by (rule exp_cf_cat_is_tiny_functor)


	subsubsection\<open>Further properties\<close>

	lemma exp_cf_cat_cf_comp:
	assumes "category \<alpha> \<DD>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD> = exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>"
	proof(rule cf_eqI)

	interpret \<DD>: category \<alpha> \<DD> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<DD>.\<Z>_Limit_\<alpha>\<omega> \<DD>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<DD>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	from \<alpha>\<beta> show
	"exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<CC>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show
	"exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD> :
	cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<CC>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ObjMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	show
	"exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ObjMap\<rparr> =
	(exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	show "vsv (exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_FUNCT_cs_intros)
	from \<alpha>\<beta> show "vsv ((exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ObjMap\<rparr>)"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	fix \<HH> assume "\<HH> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	then have "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<AA>" unfolding cat_FUNCT_components by simp
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	from assms \<alpha>\<beta> \<HH>' show
	"exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> =
	(exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	by (subst (1 2) \<HH>_def)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed simp
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ArrMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	show
	"exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ArrMap\<rparr> =
	(exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	show "vsv (exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ArrMap\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
	from \<alpha>\<beta> show "vsv ((exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	then obtain \<HH> \<HH>' where \<NN>: "\<NN> : \<HH> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<DD> \<AA>\<^esub> \<HH>'"
	by (auto intro: is_arrI)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	from \<alpha>\<beta> assms \<NN>(1,3,4) show
	"exp_cf_cat \<alpha> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<DD>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> =
	(exp_cf_cat \<alpha> \<GG> \<DD> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<DD>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	by (subst (1 2) \<NN>(2))
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_comp_cf_ntcf_comp_assoc
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed simp
	qed simp_all

	lemma exp_cf_cat_cf_id_cat:
	assumes "category \<alpha> \<CC>" and "category \<alpha> \<DD>"
	shows "exp_cf_cat \<alpha> (cf_id \<CC>) \<DD> = cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)"
	proof(rule cf_eqI)

	interpret \<CC>: category \<alpha> \<CC> by (rule assms)
	interpret \<DD>: category \<alpha> \<DD> by (rule assms)

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<CC>.\<Z>_Limit_\<alpha>\<omega> \<CC>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<CC>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	from \<alpha>\<beta> show
	"cf_id (cat_FUNCT \<alpha> \<DD> \<CC>) : cat_FUNCT \<alpha> \<DD> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<CC>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show
	"exp_cf_cat \<alpha> (cf_id \<CC>) \<DD> : cat_FUNCT \<alpha> \<DD> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<CC>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
	from \<alpha>\<beta> have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	show "exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ObjMap\<rparr> = cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ObjMap\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
	)
	fix \<HH> assume prems: "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<CC>"
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by clarsimp
	from prems \<HH>' show
	"exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> = cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	by (subst (1 2) \<HH>_def)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
	from \<alpha>\<beta> have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> (cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<CC>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	from \<alpha>\<beta> have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<CC>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
	show "exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ArrMap\<rparr> = cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<CC>\<lparr>Arr\<rparr>"
	then obtain \<FF> \<GG> where \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<DD> \<CC>\<^esub> \<GG>"
	by (auto intro: is_arrI)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	from \<NN>(1,3,4) \<alpha>\<beta> show
	"exp_cf_cat \<alpha> (cf_id \<CC>) \<DD>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> =
	cf_id (cat_FUNCT \<alpha> \<DD> \<CC>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	by (subst (1 2) \<NN>(2))
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	qed simp_all


	lemma cf_comp_exp_cf_cat_exp_cf_cat_cf_id[cat_FUNCT_cs_simps]:
	assumes "category \<alpha> \<AA>" and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA> = exp_cf_cat \<alpha> \<FF> \<AA>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule cf_eqI)
	from assms \<alpha>\<beta> \<beta> show \<FF>\<AA>:
	"exp_cf_cat \<alpha> \<FF> \<AA> : cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
	with assms \<alpha>\<beta> show
	"exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl cs_intro:
	cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms \<alpha>\<beta> have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ObjMap\<rparr>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	from assms \<alpha>\<beta> have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ArrMap\<rparr>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	show
	"(exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ObjMap\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
	)
	fix \<HH> assume prems: "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	from prems \<HH>' assms \<FF>\<AA> \<alpha>\<beta> show
	"(exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	unfolding \<HH>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	)
	qed
	(
	use assms \<FF>\<AA> \<alpha>\<beta> in
	\<open>
	cs_concl
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	\<close>
	)
	show
	"(exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ArrMap\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix \<MM> assume "\<MM> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	then obtain \<FF>' \<GG>' where \<MM>: "\<MM> : \<FF>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>'"
	by (auto intro: is_arrI)
	note \<MM> = cat_FUNCT_is_arrD[OF \<MM>]
	from \<MM>(1) assms \<FF>\<AA> \<alpha>\<beta> show
	"(exp_cf_cat \<alpha> \<FF> \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> (cf_id \<BB>) \<AA>)\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr>"
	by (subst (1 2) \<MM>(2))
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	)
	qed
	(
	use assms \<alpha>\<beta> in
	\<open>
	cs_concl cs_intro:
	cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	\<close>
	)
	qed simp_all

	qed

	lemma cf_comp_exp_cf_cat_cf_id_exp_cf_cat[cat_FUNCT_cs_simps]:
	assumes "category \<alpha> \<AA>" and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA> = exp_cf_cat \<alpha> \<FF> \<AA>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule cf_eqI)
	from assms \<alpha>\<beta> \<beta> show \<FF>\<AA>:
	"exp_cf_cat \<alpha> \<FF> \<AA> : cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
	with assms \<alpha>\<beta> show
	"exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl cs_intro:
	cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms \<alpha>\<beta> have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ObjMap\<rparr>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps)
	from assms \<alpha>\<beta> have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ArrMap\<rparr>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps)
	show
	"(exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ObjMap\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
	)
	fix \<HH> assume prems: "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	from prems \<HH>' assms \<alpha>\<beta> \<FF>\<AA> show
	"(exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	unfolding \<HH>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	)
	qed
	(
	use assms \<alpha>\<beta> \<FF>\<AA> in
	\<open>
	cs_concl
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	\<close>
	)
	show
	"(exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ArrMap\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix \<MM> assume "\<MM> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Arr\<rparr>"
	then obtain \<FF>' \<GG>' where \<MM>: "\<MM> : \<FF>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<BB>\<^esub> \<GG>'"
	by (auto intro: is_arrI)
	note \<MM> = cat_FUNCT_is_arrD[OF \<MM>]
	from \<MM>(1) assms \<alpha>\<beta> \<FF>\<AA> show
	"(exp_cf_cat \<alpha> (cf_id \<CC>) \<AA> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr> =
	exp_cf_cat \<alpha> \<FF> \<AA>\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr>"
	by (subst (1 2) \<MM>(2))
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	)
	qed
	(
	use assms \<alpha>\<beta> in
	\<open>
	cs_concl
	cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
	\<close>
	)
	qed simp_all

	qed



	subsection\<open>Category raised to the power of a functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition exp_cat_cf :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "exp_cat_cf \<alpha> \<AA> \<KK> =
	[
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>\<lparr>Obj\<rparr>.
	cf_map (cf_of_cf_map (\<KK>\<lparr>HomCod\<rparr>) \<AA> \<SS> \<circ>\<^sub>C\<^sub>F \<KK>)
	),
	(
	\<lambda>\<sigma>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>\<lparr>Arr\<rparr>.
	ntcf_arrow (ntcf_of_ntcf_arrow (\<KK>\<lparr>HomCod\<rparr>) \<AA> \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)
	),
	cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>,
	cat_FUNCT \<alpha> (\<KK>\<lparr>HomDom\<rparr>) \<AA>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma exp_cat_cf_components:
	shows "exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>\<lparr>Obj\<rparr>.
	cf_map (cf_of_cf_map (\<KK>\<lparr>HomCod\<rparr>) \<AA> \<SS> \<circ>\<^sub>C\<^sub>F \<KK>)
	)"
	and "exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>\<sigma>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>\<lparr>Arr\<rparr>.
	ntcf_arrow (ntcf_of_ntcf_arrow (\<KK>\<lparr>HomCod\<rparr>) \<AA> \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)
	)"
	and "exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> (\<KK>\<lparr>HomCod\<rparr>) \<AA>"
	and "exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> (\<KK>\<lparr>HomDom\<rparr>) \<AA>"
	unfolding exp_cat_cf_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda exp_cat_cf_components(1)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	\|vsv exp_cat_cf_components_ObjMap_vsv[cat_FUNCT_cs_intros]\|
	\|vdomain exp_cat_cf_components_ObjMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_cat_cf_components_ObjMap_app[cat_FUNCT_cs_simps]\|

	end


	subsubsection\<open>Arrow map\<close>

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda exp_cat_cf_components(2)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	\|vsv exp_cat_cf_components_ArrMap_vsv[cat_FUNCT_cs_intros]\|
	\|vdomain exp_cat_cf_components_ArrMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_cat_cf_components_ArrMap_app[cat_FUNCT_cs_simps]\|

	end


	subsubsection\<open>Domain and codomain\<close>

	context
	fixes \<alpha> \<KK> \<BB> \<CC>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	lemmas exp_cat_cf_HomDom[cat_FUNCT_cs_simps] =
	exp_cat_cf_components(3)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]
	and exp_cat_cf_HomCod[cat_FUNCT_cs_simps] =
	exp_cat_cf_components(4)[where \<KK>=\<KK> and \<alpha>=\<alpha>, unfolded cat_cs_simps]

	end


	subsubsection\<open>Category raised to the power of a functor is a functor\<close>

	lemma exp_cat_cf_is_tiny_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<AA>" and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "exp_cat_cf \<alpha> \<AA> \<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(3))
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(4))
	from assms(2-4) interpret \<CC>\<AA>: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<CC> \<AA>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2-4) interpret \<BB>\<AA>: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<BB> \<AA>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	show ?thesis
	proof(intro is_tiny_functorI' is_functorI')
	show "vfsequence (exp_cat_cf \<alpha> \<AA> \<KK>)" unfolding exp_cat_cf_def by auto
	show "vcard (exp_cat_cf \<alpha> \<AA> \<KK>) = 4\<^sub>\<nat>"
	unfolding exp_cat_cf_def by (simp_all add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<BB> \<AA>\<lparr>Obj\<rparr>"
	proof
	(
	unfold cat_FUNCT_components exp_cat_cf_components,
	intro vrange_VLambda_vsubset,
	unfold cat_cs_simps
	)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	then obtain \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	from assms(2-4) \<FF>' show
	"cf_map (cf_of_cf_map \<CC> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F \<KK>) \<in>\<^sub>\<circ> cf_maps \<alpha> \<BB> \<AA>"
	unfolding \<FF>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show "exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> :
	exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub>
	exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<rparr>"
	if "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> \<GG>" for \<FF> \<GG> \<NN>
	proof-
	note \<NN> = cat_FUNCT_is_arrD[OF that]
	from \<NN>(1) assms(2-4) show ?thesis
	by (subst \<NN>(2), use nothing in \<open>subst \<NN>(3), subst \<NN>(4)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show
	"exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr>\<lparr>\<MM> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> \<NN>\<rparr> =
	exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr>\<lparr>\<MM>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub>
	exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	if "\<MM> : \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> \<HH>" and "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> \<GG>"
	for \<GG> \<HH> \<MM> \<FF> \<NN>
	proof-
	note \<MM> = cat_FUNCT_is_arrD[OF that(1)]
	and \<NN> = cat_FUNCT_is_arrD[OF that(2)]
	from \<MM>(1) \<NN>(1) assms(2-4) show ?thesis
	by (subst (1 2) \<MM>(2), use nothing in \<open>subst (1 2) \<NN>(2)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show
	"exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ArrMap\<rparr>\<lparr>cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>CId\<rparr>\<lparr>\<FF>\<rparr>\<rparr> =
	cat_FUNCT \<alpha> \<BB> \<AA>\<lparr>CId\<rparr>\<lparr>exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr>\<rparr>"
	if "\<FF> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>" for \<FF>
	proof-
	from that have \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	unfolding cat_FUNCT_components by simp
	then obtain \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	from assms(2-4) \<FF> \<FF>' show ?thesis
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) \<FF>_def
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	qed
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
	)+
	qed

	lemma exp_cat_cf_is_tiny_functor'[cat_FUNCT_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "category \<alpha> \<AA>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = cat_FUNCT \<alpha> \<CC> \<AA>"
	and "\<BB>' = cat_FUNCT \<alpha> \<BB> \<AA>"
	shows "exp_cat_cf \<alpha> \<AA> \<KK> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>'"
	using assms(1-4) unfolding assms(5,6) by (rule exp_cat_cf_is_tiny_functor)


	subsubsection\<open>Further properties\<close>

	lemma exp_cat_cf_cat_cf_id:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<CC>"
	shows "exp_cat_cf \<alpha> \<AA> (cf_id \<CC>) = cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule cf_eqI)

	from \<alpha>\<beta> show "exp_cat_cf \<alpha> \<AA> (cf_id \<CC>) :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<CC> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show
	"cf_id (cat_FUNCT \<alpha> \<CC> \<AA>) : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<CC> \<AA>"
	by
	(
	cs_concl
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
	)
	show "exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ObjMap\<rparr> = cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1))
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	then obtain \<FF>' where \<FF>_def: "\<FF> = cf_map \<FF>'" and \<FF>': "\<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by clarsimp
	from \<FF>' show
	"exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr> =
	cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps \<FF>_def
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

	from \<alpha>\<beta> have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
	)
	show "exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ArrMap\<rparr> = cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Arr\<rparr>"
	then obtain \<HH> \<HH>' where \<NN>: "\<NN> : \<HH> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> \<HH>'"
	by (auto intro: is_arrI)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	from \<NN>(1) show
	"exp_cat_cf \<alpha> \<AA> (cf_id \<CC>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> =
	cf_id (cat_FUNCT \<alpha> \<CC> \<AA>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	by (subst (1 2) \<NN>(2))
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

	qed simp_all

	qed

	lemma exp_cat_cf_cf_comp:
	assumes "category \<alpha> \<AA>" and "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC> \<DD> \<GG> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule cf_eqI)
	from \<beta> \<alpha>\<beta> show "exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) :
	cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<beta> \<alpha>\<beta> show "exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG> :
	cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<beta> \<alpha>\<beta> have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<beta> \<alpha>\<beta> have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ObjMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<beta> \<alpha>\<beta> have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<beta> \<alpha>\<beta> have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ArrMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	show
	"exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> =
	(exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ObjMap\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
	)
	fix \<HH> assume "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<AA>"
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by clarsimp
	from \<beta> \<alpha>\<beta> \<HH>' assms show
	"exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> =
	(exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	unfolding \<HH>_def (slow)
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	(
	use \<beta> \<alpha>\<beta> in
	\<open>
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	\<close>
	)+
	show "exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> =
	(exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Arr\<rparr>"
	then obtain \<HH> \<HH>' where \<NN>: "\<NN> : \<HH> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<DD> \<AA>\<^esub> \<HH>'"
	by (auto intro: is_arrI)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	from assms \<NN>(1) \<beta> \<alpha>\<beta> show
	"exp_cat_cf \<alpha> \<AA> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr> =
	(exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<rparr>"
	by (subst (1 2) \<NN>(2))
	(
	cs_concl
	cs_simp:
	cat_FUNCT_cs_simps cat_cs_simps ntcf_cf_comp_ntcf_cf_comp_assoc
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	(
	use \<beta> \<alpha>\<beta> in
	\<open>
	cs_concl
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	\<close>
	)+
	qed simp_all

	qed



	subsection\<open>Natural transformation raised to the power of a category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition exp_ntcf_cat :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "exp_ntcf_cat \<alpha> \<NN> \<DD> =
	[
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
	ntcf_arrow (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_of_cf_map \<DD> (\<NN>\<lparr>NTDGDom\<rparr>) \<SS>)
	),
	exp_cf_cat \<alpha> (\<NN>\<lparr>NTDom\<rparr>) \<DD>,
	exp_cf_cat \<alpha> (\<NN>\<lparr>NTCod\<rparr>) \<DD>,
	cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGDom\<rparr>),
	cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma exp_ntcf_cat_components:
	shows "exp_ntcf_cat \<alpha> \<NN> \<DD>\<lparr>NTMap\<rparr> =
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
	ntcf_arrow (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_of_cf_map \<DD> (\<NN>\<lparr>NTDGDom\<rparr>) \<SS>)
	)"
	and "exp_ntcf_cat \<alpha> \<NN> \<DD>\<lparr>NTDom\<rparr> = exp_cf_cat \<alpha> (\<NN>\<lparr>NTDom\<rparr>) \<DD>"
	and "exp_ntcf_cat \<alpha> \<NN> \<DD>\<lparr>NTCod\<rparr> = exp_cf_cat \<alpha> (\<NN>\<lparr>NTCod\<rparr>) \<DD>"
	and "exp_ntcf_cat \<alpha> \<NN> \<DD>\<lparr>NTDGDom\<rparr> = cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGDom\<rparr>)"
	and "exp_ntcf_cat \<alpha> \<NN> \<DD>\<lparr>NTDGCod\<rparr> = cat_FUNCT \<alpha> \<DD> (\<NN>\<lparr>NTDGCod\<rparr>)"
	unfolding exp_ntcf_cat_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda exp_ntcf_cat_components(1)
	\|vsv exp_ntcf_cat_components_NTMap_vsv[cat_FUNCT_cs_intros]\|

	context is_ntcf
	begin

	lemmas exp_ntcf_cat_components' =
	exp_ntcf_cat_components[where \<alpha>=\<alpha> and \<NN>=\<NN>, unfolded cat_cs_simps]

	lemmas [cat_FUNCT_cs_simps] = exp_ntcf_cat_components'(2-5)

	mk_VLambda exp_ntcf_cat_components(1)[where \<NN>=\<NN>, unfolded cat_cs_simps]
	\|vdomain exp_ntcf_cat_components_NTMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_ntcf_cat_components_NTMap_app[cat_FUNCT_cs_simps]\|

	end

	lemmas [cat_FUNCT_cs_simps] =
	is_ntcf.exp_ntcf_cat_components'(2-5)
	is_ntcf.exp_ntcf_cat_components_NTMap_vdomain
	is_ntcf.exp_ntcf_cat_components_NTMap_app


	subsubsection\<open>
	Natural transformation raised to the power of a category
	is a natural transformation
	\<close>

	lemma exp_ntcf_cat_is_tiny_ntcf:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<DD>"
	shows "exp_ntcf_cat \<alpha> \<NN> \<DD> :
	exp_cf_cat \<alpha> \<FF> \<DD> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y exp_cf_cat \<alpha> \<GG> \<DD> :
	cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	proof(rule is_tiny_ntcfI')

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(4))

	let ?exp_\<NN> = \<open>exp_ntcf_cat \<alpha> \<NN> \<DD>\<close>
	let ?exp_\<FF> = \<open>exp_cf_cat \<alpha> \<FF> \<DD>\<close>
	let ?exp_\<GG> = \<open>exp_cf_cat \<alpha> \<GG> \<DD>\<close>

	from assms(1,2) show
	"exp_cf_cat \<alpha> \<FF> \<DD> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(1,2) show
	"exp_cf_cat \<alpha> \<GG> \<DD> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	show "?exp_\<NN> :
	?exp_\<FF> \<mapsto>\<^sub>C\<^sub>F ?exp_\<GG> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	proof(rule is_ntcfI')

	show "vfsequence (?exp_\<NN>)" unfolding exp_ntcf_cat_def by auto
	show "vcard (?exp_\<NN>) = 5\<^sub>\<nat>"
	unfolding exp_ntcf_cat_def by (simp add: nat_omega_simps)

	from assms(1,2) show "?exp_\<FF> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from assms(1,2) show "?exp_\<GG> : cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<BB>"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	show "?exp_\<NN>\<lparr>NTMap\<rparr>\<lparr>\<HH>\<rparr> :
	?exp_\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<DD> \<BB>\<^esub> ?exp_\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	if "\<HH> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>" for \<HH>
	proof-
	from that[unfolded cat_FUNCT_cs_simps] have "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<AA>" by simp
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	from \<HH>' show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps \<HH>_def
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed

	show
	"?exp_\<NN>\<lparr>NTMap\<rparr>\<lparr>\<TT>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<DD> \<BB>\<^esub> ?exp_\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<LL>\<rparr> =
	?exp_\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<LL>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<DD> \<BB>\<^esub> ?exp_\<NN>\<lparr>NTMap\<rparr>\<lparr>\<SS>\<rparr>"
	if "\<LL> : \<SS> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<DD> \<AA>\<^esub> \<TT>" for \<SS> \<TT> \<LL>
	proof-
	note \<LL> = cat_FUNCT_is_arrD[OF that]
	let ?\<SS> = \<open>cf_of_cf_map \<DD> \<AA> \<SS>\<close>
	and ?\<TT> = \<open>cf_of_cf_map \<DD> \<AA> \<TT>\<close>
	and ?\<LL> = \<open>ntcf_of_ntcf_arrow \<DD> \<AA> \<LL>\<close>
	have [cat_cs_simps]:
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) =
	(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<SS>)"
	proof(rule ntcf_eqI)
	from \<LL>(1) show
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) :
	\<FF> \<circ>\<^sub>C\<^sub>F ?\<SS> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F ?\<TT> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros)
	from \<LL>(1) show
	"(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<SS>) :
	\<FF> \<circ>\<^sub>C\<^sub>F ?\<SS> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F ?\<TT> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros)
	from \<LL>(1) have dom_lhs:
	"\<D>\<^sub>\<circ> (((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>))\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from \<LL>(1) have dom_rhs:
	"\<D>\<^sub>\<circ> (((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<SS>))\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show
	"((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>))\<lparr>NTMap\<rparr> =
	((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<SS>))\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix d assume "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	with \<LL>(1) show
	"((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>))\<lparr>NTMap\<rparr>\<lparr>d\<rparr> =
	((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<LL>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F ?\<SS>))\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (cs_concl cs_intro: cat_cs_intros)
	qed simp_all
	from \<LL>(1,3,4) that show ?thesis
	by (subst (1 2) \<LL>(2), use nothing in \<open>subst \<LL>(3), subst \<LL>(4)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	qed
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)+

	qed

	lemma exp_ntcf_cat_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<DD>"
	and "\<FF>' = exp_cf_cat \<alpha> \<FF> \<DD>"
	and "\<GG>' = exp_cf_cat \<alpha> \<GG> \<DD>"
	and "\<AA>' = cat_FUNCT \<alpha> \<DD> \<AA>"
	and "\<BB>' = cat_FUNCT \<alpha> \<DD> \<BB>"
	shows "exp_ntcf_cat \<alpha> \<NN> \<DD> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>'"
	using assms(1-4) unfolding assms(5-8) by (rule exp_ntcf_cat_is_tiny_ntcf)


	subsubsection\<open>Further properties\<close>

	lemma exp_ntcf_cat_cf_ntcf_comp:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "category \<alpha> \<DD>"
	shows
	"exp_ntcf_cat \<alpha> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<DD> =
	exp_cf_cat \<alpha> \<HH> \<DD> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<DD>"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<NN>.\<Z>_Limit_\<alpha>\<omega> \<NN>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<NN>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_ntcf_cat \<alpha> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<DD>\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cf_cat \<alpha> \<HH> \<DD> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<DD>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	show
	"exp_ntcf_cat \<alpha> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<DD>\<lparr>NTMap\<rparr> =
	(exp_cf_cat \<alpha> \<HH> \<DD> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<DD>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<KK> assume prems: "\<KK> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<AA>"
	then obtain \<KK>' where \<KK>_def: "\<KK> = cf_map \<KK>'" and \<KK>': "\<KK>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (auto intro: is_arrI)
	from \<alpha>\<beta> prems \<KK>' show
	"exp_ntcf_cat \<alpha> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<DD>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr> =
	(exp_cf_cat \<alpha> \<HH> \<DD> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<DD>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	cf_ntcf_comp_ntcf_cf_comp_assoc
	cat_cs_simps cat_FUNCT_cs_simps
	\<KK>_def
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed
	(
	cs_concl
	cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+

	qed

	lemma exp_ntcf_cat_ntcf_cf_comp:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<DD>"
	shows
	"exp_ntcf_cat \<alpha> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) \<DD> =
	exp_ntcf_cat \<alpha> \<NN> \<DD> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<DD>"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<NN>.\<Z>_Limit_\<alpha>\<omega> \<NN>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<NN>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_ntcf_cat \<alpha> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) \<DD>\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_ntcf_cat \<alpha> \<NN> \<DD> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<DD>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<DD> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	show
	"exp_ntcf_cat \<alpha> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) \<DD>\<lparr>NTMap\<rparr> =
	(exp_ntcf_cat \<alpha> \<NN> \<DD> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<DD>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<KK> assume prems: "\<KK> \<in>\<^sub>\<circ> cf_maps \<alpha> \<DD> \<AA>"
	then obtain \<KK>' where \<KK>_def: "\<KK> = cf_map \<KK>'" and \<KK>': "\<KK>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (auto intro: is_arrI)
	from \<alpha>\<beta> assms prems \<KK>' show
	"exp_ntcf_cat \<alpha> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) \<DD>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr> =
	(exp_ntcf_cat \<alpha> \<NN> \<DD> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<DD>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	ntcf_cf_comp_ntcf_cf_comp_assoc
	cat_cs_simps cat_FUNCT_cs_simps
	\<KK>_def
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed
	(
	cs_concl
	cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+
	qed

	lemma exp_ntcf_cat_ntcf_vcomp:
	assumes "category \<alpha> \<AA>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"exp_ntcf_cat \<alpha> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<AA> =
	exp_ntcf_cat \<alpha> \<MM> \<AA> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<AA>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<GG> \<HH> \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> show
	"exp_ntcf_cat \<alpha> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<AA> :
	exp_cf_cat \<alpha> \<FF> \<AA> \<mapsto>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show
	"exp_ntcf_cat \<alpha> \<MM> \<AA> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<AA> :
	exp_cf_cat \<alpha> \<FF> \<AA> \<mapsto>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<HH> \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_ntcf_cat \<alpha> \<MM> \<AA> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<AA>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	have dom_rhs:
	"\<D>\<^sub>\<circ> (exp_ntcf_cat \<alpha> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<AA>\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
	show
	"exp_ntcf_cat \<alpha> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<AA>\<lparr>NTMap\<rparr> =
	(exp_ntcf_cat \<alpha> \<MM> \<AA> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<AA>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<FF>' assume "\<FF>' \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<FF>''
	where \<FF>'_def: "\<FF>' = cf_map \<FF>''" and \<FF>'': "\<FF>'' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<FF>'' \<alpha>\<beta> show
	"exp_ntcf_cat \<alpha> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<AA>\<lparr>NTMap\<rparr>\<lparr>\<FF>'\<rparr> =
	(exp_ntcf_cat \<alpha> \<MM> \<AA> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> \<NN> \<AA>)\<lparr>NTMap\<rparr>\<lparr>\<FF>'\<rparr>"
	unfolding \<FF>'_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
	qed simp_all

	qed

	lemma ntcf_id_exp_cf_cat:
	assumes "category \<alpha> \<AA>" and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "ntcf_id (exp_cf_cat \<alpha> \<FF> \<AA>) = exp_ntcf_cat \<alpha> (ntcf_id \<FF>) \<AA>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> show "exp_ntcf_cat \<alpha> (ntcf_id \<FF>) \<AA> :
	exp_cf_cat \<alpha> \<FF> \<AA> \<mapsto>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show "ntcf_id (exp_cf_cat \<alpha> \<FF> \<AA>) :
	exp_cf_cat \<alpha> \<FF> \<AA> \<mapsto>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<AA> :
	cat_FUNCT \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> assms have dom_lhs:
	"\<D>\<^sub>\<circ> (ntcf_id (exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> assms have dom_rhs:
	"\<D>\<^sub>\<circ> (exp_ntcf_cat \<alpha> (ntcf_id \<FF>) \<AA>\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	show
	"ntcf_id (exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>NTMap\<rparr> = exp_ntcf_cat \<alpha> (ntcf_id \<FF>) \<AA>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<GG> assume "\<GG> \<in>\<^sub>\<circ> cf_maps \<alpha> \<AA> \<BB>"
	then obtain \<GG>'
	where \<GG>_def: "\<GG> = cf_map \<GG>'" and \<GG>': "\<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from \<GG>' \<alpha>\<beta> show
	"ntcf_id (exp_cf_cat \<alpha> \<FF> \<AA>)\<lparr>NTMap\<rparr>\<lparr>\<GG>\<rparr> =
	exp_ntcf_cat \<alpha> (ntcf_id \<FF>) \<AA>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<rparr>"
	unfolding \<GG>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	(
	cs_concl
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+
	qed simp_all
	qed



	subsection\<open>Category raised to the power of the natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition exp_cat_ntcf :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "exp_cat_ntcf \<alpha> \<CC> \<NN> =
	[
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGCod\<rparr>) \<CC>\<lparr>Obj\<rparr>.
	ntcf_arrow (cf_of_cf_map (\<NN>\<lparr>NTDGCod\<rparr>) \<CC> \<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)
	),
	exp_cat_cf \<alpha> \<CC> (\<NN>\<lparr>NTDom\<rparr>),
	exp_cat_cf \<alpha> \<CC> (\<NN>\<lparr>NTCod\<rparr>),
	cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGCod\<rparr>) \<CC>,
	cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGDom\<rparr>) \<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma exp_cat_ntcf_components:
	shows "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTMap\<rparr> =
	(
	\<lambda>\<SS>\<in>\<^sub>\<circ>cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGCod\<rparr>) \<CC>\<lparr>Obj\<rparr>.
	ntcf_arrow (cf_of_cf_map (\<NN>\<lparr>NTDGCod\<rparr>) \<CC> \<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)
	)"
	and "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTDom\<rparr> = exp_cat_cf \<alpha> \<CC> (\<NN>\<lparr>NTDom\<rparr>)"
	and "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTCod\<rparr> = exp_cat_cf \<alpha> \<CC> (\<NN>\<lparr>NTCod\<rparr>)"
	and "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTDGDom\<rparr> = cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGCod\<rparr>) \<CC>"
	and "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTDGCod\<rparr> = cat_FUNCT \<alpha> (\<NN>\<lparr>NTDGDom\<rparr>) \<CC>"
	unfolding exp_cat_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda exp_cat_ntcf_components(1)
	\|vsv exp_cat_ntcf_components_NTMap_vsv[cat_FUNCT_cs_intros]\|

	context is_ntcf
	begin

	lemmas exp_cat_ntcf_components' =
	exp_cat_ntcf_components[where \<alpha>=\<alpha> and \<NN>=\<NN>, unfolded cat_cs_simps]

	lemmas [cat_FUNCT_cs_simps] = exp_cat_ntcf_components'(2-5)

	mk_VLambda exp_cat_ntcf_components(1)[where \<NN>=\<NN>, unfolded cat_cs_simps]
	\|vdomain exp_cat_ntcf_components_NTMap_vdomain[cat_FUNCT_cs_simps]\|
	\|app exp_cat_ntcf_components_NTMap_app[cat_FUNCT_cs_simps]\|

	end

	lemmas exp_cat_ntcf_components' = is_ntcf.exp_cat_ntcf_components'

	lemmas [cat_FUNCT_cs_simps] =
	is_ntcf.exp_cat_ntcf_components'(2-5)
	is_ntcf.exp_cat_ntcf_components_NTMap_vdomain
	is_ntcf.exp_cat_ntcf_components_NTMap_app


	subsubsection\<open>
	Category raised to the power of a natural transformation
	is a natural transformation
	\<close>

	lemma exp_cat_ntcf_is_tiny_ntcf:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<CC>"
	shows "exp_cat_ntcf \<alpha> \<CC> \<NN> :
	exp_cat_cf \<alpha> \<CC> \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y exp_cat_cf \<alpha> \<CC> \<GG> :
	cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	proof(rule is_tiny_ntcfI')

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(4))

	let ?exp_\<NN> = \<open>exp_cat_ntcf \<alpha> \<CC> \<NN>\<close>
	let ?exp_\<FF> = \<open>exp_cat_cf \<alpha> \<CC> \<FF>\<close>
	let ?exp_\<GG> = \<open>exp_cat_cf \<alpha> \<CC> \<GG>\<close>

	from assms(1,2) show
	"exp_cat_cf \<alpha> \<CC> \<GG> : cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(1,2) show
	"exp_cat_cf \<alpha> \<CC> \<FF> : cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	show "?exp_\<NN> : ?exp_\<FF> \<mapsto>\<^sub>C\<^sub>F ?exp_\<GG> : cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	proof(rule is_ntcfI')

	show "vfsequence (?exp_\<NN>)" unfolding exp_cat_ntcf_def by auto
	show "vcard (?exp_\<NN>) = 5\<^sub>\<nat>"
	unfolding exp_cat_ntcf_def by (simp add: nat_omega_simps)

	from assms(1,2) show
	"exp_cat_cf \<alpha> \<CC> \<GG> : cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	from assms(1,2) show
	"exp_cat_cf \<alpha> \<CC> \<FF> : cat_FUNCT \<alpha> \<BB> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> \<CC>"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	show "exp_cat_ntcf \<alpha> \<CC> \<NN>\<lparr>NTMap\<rparr>\<lparr>\<HH>\<rparr> :
	exp_cat_cf \<alpha> \<CC> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<AA> \<CC>\<^esub>
	exp_cat_cf \<alpha> \<CC> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<HH>\<rparr>"
	if "\<HH> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<BB> \<CC>\<lparr>Obj\<rparr>" for \<HH>
	proof-
	from that[unfolded cat_FUNCT_cs_simps] have "\<HH> \<in>\<^sub>\<circ> cf_maps \<alpha> \<BB> \<CC>" by simp
	then obtain \<HH>' where \<HH>_def: "\<HH> = cf_map \<HH>'" and \<HH>': "\<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by auto
	from \<HH>' show ?thesis
	unfolding \<HH>_def
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps \<HH>_def
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed

	show
	"?exp_\<NN>\<lparr>NTMap\<rparr>\<lparr>\<TT>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<CC>\<^esub> ?exp_\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<LL>\<rparr> =
	?exp_\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<LL>\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> \<CC>\<^esub> ?exp_\<NN>\<lparr>NTMap\<rparr>\<lparr>\<SS>\<rparr>"
	if "\<LL> : \<SS> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<CC>\<^esub> \<TT>" for \<SS> \<TT> \<LL>
	proof-
	note \<LL> = cat_FUNCT_is_arrD[OF that]
	let ?\<SS> = \<open>cf_of_cf_map \<BB> \<CC> \<SS>\<close>
	and ?\<TT> = \<open>cf_of_cf_map \<BB> \<CC> \<TT>\<close>
	and ?\<LL> = \<open>ntcf_of_ntcf_arrow \<BB> \<CC> \<LL>\<close>
	have [cat_cs_simps]:
	"(?\<TT> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) =
	(?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof(rule ntcf_eqI)
	from \<LL>(1) show
	"(?\<TT> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) :
	?\<SS> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F ?\<TT> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	from \<LL>(1) show
	"(?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	?\<SS> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F ?\<TT> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	from \<LL>(1) have dom_lhs:
	"\<D>\<^sub>\<circ> (((?\<TT> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>))\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from \<LL>(1) have dom_rhs:
	"\<D>\<^sub>\<circ> (((?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show
	"((?\<TT> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>))\<lparr>NTMap\<rparr> =
	((?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with \<LL>(1) show
	"((?\<TT> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	((?\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<SS> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps is_ntcf.ntcf_Comp_commute
	cs_intro: cat_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros)
	qed simp_all
	from \<LL>(1,3,4) that show ?thesis
	by (subst (1 2) \<LL>(2), use nothing in \<open>subst \<LL>(3), subst \<LL>(4)\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed

	qed
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)+

	qed

	lemma exp_cat_ntcf_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<FF>' = exp_cat_cf \<alpha> \<CC> \<FF>"
	and "\<GG>' = exp_cat_cf \<alpha> \<CC> \<GG>"
	and "\<AA>' = cat_FUNCT \<alpha> \<BB> \<CC>"
	and "\<BB>' = cat_FUNCT \<alpha> \<AA> \<CC>"
	shows "exp_cat_ntcf \<alpha> \<CC> \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>'"
	using assms(1-4) unfolding assms(5-8) by (rule exp_cat_ntcf_is_tiny_ntcf)


	subsubsection\<open>Further properties\<close>

	lemma ntcf_id_exp_cat_cf:
	assumes "category \<alpha> \<AA>" and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>) = exp_cat_ntcf \<alpha> \<AA> (ntcf_id \<FF>)"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> show "exp_cat_ntcf \<alpha> \<AA> (ntcf_id \<FF>) :
	exp_cat_cf \<alpha> \<AA> \<FF> \<mapsto>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from assms \<beta> \<alpha>\<beta> show "ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>) :
	exp_cat_cf \<alpha> \<AA> \<FF> \<mapsto>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> assms have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_ntcf \<alpha> \<AA> (ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> assms have dom_rhs:
	"\<D>\<^sub>\<circ> (ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>)\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	show
	"ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>)\<lparr>NTMap\<rparr> = exp_cat_ntcf \<alpha> \<AA> (ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<GG> assume "\<GG> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	then obtain \<GG>'
	where \<GG>_def: "\<GG> = cf_map \<GG>'" and \<GG>': "\<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	from \<GG>' \<alpha>\<beta> show
	"ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>)\<lparr>NTMap\<rparr>\<lparr>\<GG>\<rparr> =
	exp_cat_ntcf \<alpha> \<AA> (ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>\<GG>\<rparr>"
	unfolding \<GG>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	(
	cs_concl
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+
	qed simp_all

	qed

	lemma exp_cat_ntcf_ntcf_cf_comp:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "category \<alpha> \<DD>"
	shows
	"exp_cat_ntcf \<alpha> \<DD> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) =
	exp_cat_cf \<alpha> \<DD> \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<DD> \<NN>"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<NN>.\<Z>_Limit_\<alpha>\<omega> \<NN>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<NN>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_ntcf \<alpha> \<DD> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cat_cf \<alpha> \<DD> \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<DD> \<NN>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	show
	"exp_cat_ntcf \<alpha> \<DD> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr> =
	(exp_cat_cf \<alpha> \<DD> \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<DD> \<NN>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<KK> assume prems: "\<KK> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<DD>"
	then obtain \<KK>' where \<KK>_def: "\<KK> = cf_map \<KK>'" and \<KK>': "\<KK>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (auto intro: is_arrI)
	from \<alpha>\<beta> assms prems \<KK>' show
	"exp_cat_ntcf \<alpha> \<DD> (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr> =
	(exp_cat_cf \<alpha> \<DD> \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<DD> \<NN>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr>"
	unfolding \<KK>_def
	by
	(
	cs_concl
	cs_simp:
	cf_ntcf_comp_ntcf_cf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed
	(
	cs_concl
	cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+

	qed

	lemma exp_cat_ntcf_cf_ntcf_comp:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "category \<alpha> \<DD>"
	shows
	"exp_cat_ntcf \<alpha> \<DD> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
	exp_cat_ntcf \<alpha> \<DD> \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<DD> \<HH>"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<NN>.\<Z>_Limit_\<alpha>\<omega> \<NN>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<NN>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)

	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> (exp_cat_ntcf \<alpha> \<DD> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cat_ntcf \<alpha> \<DD> \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<DD> \<HH>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	show
	"exp_cat_ntcf \<alpha> \<DD> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> =
	(exp_cat_ntcf \<alpha> \<DD> \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<DD> \<HH>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<KK> assume prems: "\<KK> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<DD>"
	then obtain \<KK>' where \<KK>_def: "\<KK> = cf_map \<KK>'" and \<KK>': "\<KK>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (auto intro: is_arrI)
	from assms \<alpha>\<beta> prems \<KK>' show
	"exp_cat_ntcf \<alpha> \<DD> (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr> =
	(exp_cat_ntcf \<alpha> \<DD> \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<DD> \<HH>)\<lparr>NTMap\<rparr>\<lparr>\<KK>\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	cf_comp_cf_ntcf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps \<KK>_def
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	qed
	(
	cs_concl
	cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: \<alpha>\<beta> cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)+

	qed

	lemma exp_cat_ntcf_ntcf_vcomp:
	assumes "category \<alpha> \<AA>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"exp_cat_ntcf \<alpha> \<AA> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
	exp_cat_ntcf \<alpha> \<AA> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> \<NN>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<GG> \<HH> \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(3))

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<AA>.\<Z>_Limit_\<alpha>\<omega> \<AA>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<AA>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(rule ntcf_eqI)
	from \<beta> \<alpha>\<beta> show
	"exp_cat_ntcf \<alpha> \<AA> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	exp_cat_cf \<alpha> \<AA> \<FF> \<mapsto>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<HH> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> show
	"exp_cat_ntcf \<alpha> \<AA> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> \<NN> :
	exp_cat_cf \<alpha> \<AA> \<FF> \<mapsto>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<HH> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_lhs:
	"\<D>\<^sub>\<circ> ((exp_cat_ntcf \<alpha> \<AA> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>) = cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> have dom_rhs:
	"\<D>\<^sub>\<circ> ((exp_cat_ntcf \<alpha> \<AA> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> \<NN>)\<lparr>NTMap\<rparr>) =
	cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	show
	"exp_cat_ntcf \<alpha> \<AA> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> =
	(exp_cat_ntcf \<alpha> \<AA> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> \<NN>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
	fix \<FF>' assume "\<FF>' \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	then obtain \<FF>''
	where \<FF>'_def: "\<FF>' = cf_map \<FF>''" and \<FF>'': "\<FF>'' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by clarsimp
	from \<FF>'' \<alpha>\<beta> show
	"exp_cat_ntcf \<alpha> \<AA> (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>\<FF>'\<rparr> =
	(exp_cat_ntcf \<alpha> \<AA> \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> \<NN>)\<lparr>NTMap\<rparr>\<lparr>\<FF>'\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp \<FF>'_def
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+

	qed simp_all

	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
	@@ -1,2092 +1,2234 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Functor\<close>
	theory CZH_ECAT_Functor
	imports
	CZH_ECAT_Category
	CZH_Foundations.CZH_SMC_Semifunctor
	begin



	subsection\<open>Background\<close>

	named_theorems cf_cs_simps
	named_theorems cf_cs_intros

	named_theorems cat_cn_cs_simps
	named_theorems cat_cn_cs_intros

	lemmas [cat_cs_simps] = dg_shared_cs_simps
	lemmas [cat_cs_intros] = dg_shared_cs_intros


	subsubsection\<open>Slicing\<close>

	definition cf_smcf :: "V \<Rightarrow> V"
	where "cf_smcf \<CC> =
	[\<CC>\<lparr>ObjMap\<rparr>, \<CC>\<lparr>ArrMap\<rparr>, cat_smc (\<CC>\<lparr>HomDom\<rparr>), cat_smc (\<CC>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_smcf_components:
	shows [slicing_simps]: "cf_smcf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and [slicing_simps]: "cf_smcf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and [slicing_commute]: "cf_smcf \<FF>\<lparr>HomDom\<rparr> = cat_smc (\<FF>\<lparr>HomDom\<rparr>)"
	and [slicing_commute]: "cf_smcf \<FF>\<lparr>HomCod\<rparr> = cat_smc (\<FF>\<lparr>HomCod\<rparr>)"
	unfolding cf_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)



	subsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_functor =
	\<Z> \<alpha> + vfsequence \<FF> + HomDom: category \<alpha> \<AA> + HomCod: category \<alpha> \<BB>
	for \<alpha> \<AA> \<BB> \<FF> +
	assumes cf_length[cat_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>"
	and cf_is_semifunctor[slicing_intros]:
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	and cf_HomDom[cat_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and cf_HomCod[cat_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and cf_ObjMap_CId[cat_cs_intros]:
	"c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"

	syntax "_is_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_functor \<alpha> \<AA> \<BB> \<FF>"

	abbreviation (input) is_cn_cf :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_cn_cf \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"

	syntax "_is_cn_cf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<^sub>C\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_cf \<alpha> \<AA> \<BB> \<FF>"

	abbreviation all_cfs :: "V \<Rightarrow> V"
	where "all_cfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation cfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemmas [cat_cs_simps] =
	is_functor.cf_length
	is_functor.cf_HomDom
	is_functor.cf_HomCod
	is_functor.cf_ObjMap_CId

	lemma cn_cf_ObjMap_CId[cat_cn_cs_simps]:
	assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	proof-
	interpret is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(1))
	from assms(2) have c: "c \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	show ?thesis by (rule cf_ObjMap_CId[OF c, unfolded cat_op_simps])
	qed

	lemma (in is_functor) cf_is_semifunctor':
	assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule cf_is_semifunctor)

	lemmas [slicing_intros] = is_functor.cf_is_semifunctor'

	lemma cn_smcf_comp_is_semifunctor:
	assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "cf_smcf \<FF> : cat_smc \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub>cat_smc \<BB>"
	using assms
	unfolding slicing_simps slicing_commute
	by (rule is_functor.cf_is_semifunctor)

	lemma cn_smcf_comp_is_semifunctor'[slicing_intros]:
	assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<AA>' = op_smc (cat_smc \<AA>)"
	and "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cn_smcf_comp_is_semifunctor)


	text\<open>Rules.\<close>

	lemma (in is_functor) is_functor_axioms'[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_functor_axioms)

	mk_ide rf is_functor_def[unfolded is_functor_axioms_def]
	\|intro is_functorI\|
	\|dest is_functorD[dest]\|
	\|elim is_functorE[elim]\|

	lemmas [cat_cs_intros] = is_functorD(3,4)

	lemma is_functorI':
	assumes "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	intro is_functorI is_semifunctorI',
	unfold cf_smcf_components slicing_simps
	)
	(simp_all add: assms cf_smcf_def nat_omega_simps category.cat_semicategory)

	lemma is_functorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
	by
	(
	simp_all add:
	is_functorD(2-9)[OF assms]
	is_semifunctorD'[OF is_functorD(6)[OF assms], unfolded slicing_simps]
	)

	lemma is_functorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
	using assms by (simp add: is_functorD')


	text\<open>A functor is a semifunctor.\<close>

	context is_functor
	begin

	interpretation smcf: is_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule cf_is_semifunctor)

	sublocale ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	by (rule smcf.ObjMap.vsv_axioms[unfolded slicing_simps])
	sublocale ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	by (rule smcf.ArrMap.vsv_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	cf_ObjMap_vsv = smcf.smcf_ObjMap_vsv
	and cf_ArrMap_vsv = smcf.smcf_ArrMap_vsv
	and cf_ObjMap_vdomain[cat_cs_simps] = smcf.smcf_ObjMap_vdomain
	and cf_ObjMap_vrange = smcf.smcf_ObjMap_vrange
	and cf_ArrMap_vdomain[cat_cs_simps] = smcf.smcf_ArrMap_vdomain
	and cf_ArrMap_is_arr = smcf.smcf_ArrMap_is_arr
	and cf_ArrMap_is_arr''[cat_cs_intros] = smcf.smcf_ArrMap_is_arr''
	and cf_ArrMap_is_arr'[cat_cs_intros] = smcf.smcf_ArrMap_is_arr'
	and cf_ObjMap_app_in_HomCod_Obj[cat_cs_intros] =
	smcf.smcf_ObjMap_app_in_HomCod_Obj
	and cf_ArrMap_vrange = smcf.smcf_ArrMap_vrange
	and cf_ArrMap_app_in_HomCod_Arr[cat_cs_intros] =
	smcf.smcf_ArrMap_app_in_HomCod_Arr
	and cf_ObjMap_vsubset_Vset = smcf.smcf_ObjMap_vsubset_Vset
	and cf_ArrMap_vsubset_Vset = smcf.smcf_ArrMap_vsubset_Vset
	and cf_ObjMap_in_Vset = smcf.smcf_ObjMap_in_Vset
	and cf_ArrMap_in_Vset = smcf.smcf_ArrMap_in_Vset
	and cf_is_semifunctor_if_ge_Limit = smcf.smcf_is_semifunctor_if_ge_Limit
	and cf_is_arr_HomCod = smcf.smcf_is_arr_HomCod
	and cf_vimage_dghm_ArrMap_vsubset_Hom =
	smcf.smcf_vimage_dghm_ArrMap_vsubset_Hom

	lemmas_with [unfolded slicing_simps]:
	cf_ArrMap_Comp = smcf.smcf_ArrMap_Comp

	end

	lemmas [cat_cs_simps] =
	is_functor.cf_ObjMap_vdomain
	is_functor.cf_ArrMap_vdomain
	is_functor.cf_ArrMap_Comp

	lemmas [cat_cs_intros] =
	is_functor.cf_ObjMap_app_in_HomCod_Obj
	is_functor.cf_ArrMap_app_in_HomCod_Arr
	is_functor.cf_ArrMap_is_arr'


	text\<open>Elementary properties.\<close>

	lemma cn_cf_ArrMap_Comp[cat_cn_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	and "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule cn_smcf_ArrMap_Comp
	[
	OF
	\<AA>.cat_semicategory
	\<FF>.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_simps,
	OF assms(3,4)
	]
	)
	qed

	lemma cf_eqI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	shows "\<GG> = \<FF>"
	proof(rule vsv_eqI)
	interpret L: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	from assms(1) show "vsv \<GG>" by auto
	from assms(2) show "vsv \<FF>" by auto
	have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<GG> = \<D>\<^sub>\<circ> \<FF>" by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by (simp_all add: cat_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
	(auto simp: dghm_field_simps)
	qed

	lemma cf_smcf_eqI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	and "cf_smcf \<GG> = cf_smcf \<FF>"
	shows "\<GG> = \<FF>"
	proof(rule cf_eqI)
	from assms(5) have
	"cf_smcf \<GG>\<lparr>ObjMap\<rparr> = cf_smcf \<FF>\<lparr>ObjMap\<rparr>"
	"cf_smcf \<GG>\<lparr>ArrMap\<rparr> = cf_smcf \<FF>\<lparr>ArrMap\<rparr>"
	by simp_all
	then show "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	unfolding slicing_simps by simp_all
	qed (auto intro: assms(1,2) simp: assms(3-5))

	lemma (in is_functor) cf_def: "\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>Obj\<rparr>, \<FF>\<lparr>Arr\<rparr>, \<FF>\<lparr>Dom\<rparr>, \<FF>\<lparr>Cod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
	(simp_all add: nat_omega_simps)
	qed (auto simp: vsv_axioms)


	text\<open>Size.\<close>

	lemma (in is_functor) cf_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [cat_cs_intros] =
	cf_ObjMap_in_Vset
	cf_ArrMap_in_Vset
	HomDom.cat_in_Vset
	HomCod.cat_in_Vset
	from assms(2) show ?thesis
	by (subst cf_def)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma (in is_functor) cf_is_functor_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
	by (rule is_functorI)
	(
	auto simp:
	cat_cs_simps
	assms
	vfsequence_axioms
	cf_is_semifunctor_if_ge_Limit
	HomDom.cat_category_if_ge_Limit
	HomCod.cat_category_if_ge_Limit
	intro: cat_cs_intros
	)

	lemma small_all_cfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_functor.cf_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in is_functor) cf_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], cat_cs_intros] =
	cf_ObjMap_vsubset_Vset
	cf_ArrMap_vsubset_Vset
	from HomDom.cat_category_in_Vset_4 have [cat_cs_intros]:
	"\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	from HomCod.cat_category_in_Vset_4 have [cat_cs_intros]:
	"\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	show ?thesis
	by (subst cf_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma (in \<Z>) all_cfs_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "all_cfs \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "all_cfs \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_cfs \<alpha>"
	then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
	interpret is_functor \<alpha> \<AA> \<BB> \<FF> using \<FF> by simp
	show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule cf_in_Vset_7)
	qed
	from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma small_cfs[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto


	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_functor) cf_ArrMap_is_iso_arr:
	+ assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> b"
	+ shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+proof-
	+
	+ note f = is_iso_arrD(1)[OF assms(1)]
	+ note HomDom.cat_the_inverse_is_iso_arr[OF assms]
	+ note inv_f = this is_iso_arrD(1)[OF this]
	+
	+ show ?thesis
	+ proof(intro is_iso_arrI is_inverseI)
	+ from inv_f(2) show \<FF>_inv_f:
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ note cf_ArrMap_Comp is_functor.cf_ArrMap_Comp[cat_cs_simps del]
	+ from assms f(1) inv_f show
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cf_ArrMap_Comp[symmetric]
	+ cs_intro: cat_cs_intros
	+ )+
	+ qed (intro cf_ArrMap_is_arr[OF f(1)])+
	+
	+qed
	+
	+lemma (in is_functor) cf_ArrMap_is_iso_arr'[cat_arrow_cs_intros]:
	+ assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> b" and "\<FF>a = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" and "\<FF>b = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+ shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>b"
	+ using assms(1) unfolding assms(2,3) by (rule cf_ArrMap_is_iso_arr)
	+
	+lemmas [cat_arrow_cs_intros] = is_functor.cf_ArrMap_is_iso_arr'
	+
	+

	subsection\<open>Opposite functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_cf :: "V \<Rightarrow> V"
	where "op_cf \<FF> =
	[\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_cat (\<FF>\<lparr>HomDom\<rparr>), op_cat (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_cf_components[cat_op_simps]:
	shows "op_cf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "op_cf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "op_cf \<FF>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>)"
	and "op_cf \<FF>\<lparr>HomCod\<rparr> = op_cat (\<FF>\<lparr>HomCod\<rparr>)"
	unfolding op_cf_def dghm_field_simps by (auto simp: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cf_smcf_op_cf[slicing_commute]: "op_smcf (cf_smcf \<FF>) = cf_smcf (op_cf \<FF>)"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) = 4\<^sub>\<nat>"
	unfolding op_smcf_def by (auto simp: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (cf_smcf (op_cf \<FF>)) = 4\<^sub>\<nat>"
	unfolding cf_smcf_def by (auto simp: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) = \<D>\<^sub>\<circ> (cf_smcf (op_cf \<FF>))"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) \<Longrightarrow>
	op_smcf (cf_smcf \<FF>)\<lparr>a\<rparr> = cf_smcf (op_cf \<FF>)\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cf_smcf_def op_cf_def op_smcf_def dghm_field_simps
	)
	(auto simp: nat_omega_simps slicing_commute)
	qed (auto simp: cf_smcf_def op_smcf_def)


	text\<open>Elementary properties.\<close>

	lemma op_cf_vsv[cat_op_intros]: "vsv (op_cf \<FF>)" unfolding op_cf_def by auto


	subsubsection\<open>Further properties\<close>

	lemma (in is_functor) is_functor_op: "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	proof(intro is_functorI, unfold cat_op_simps)
	show "vfsequence (op_cf \<FF>)" unfolding op_cf_def by simp
	show "vcard (op_cf \<FF>) = 4\<^sub>\<nat>"
	unfolding op_cf_def by (auto simp: nat_omega_simps)
	fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	then show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	unfolding cat_op_simps by (auto intro: cat_cs_intros)
	qed
	(
	auto simp:
	cat_cs_simps
	slicing_commute[symmetric]
	is_semifunctor.is_semifunctor_op
	cf_is_semifunctor
	HomCod.category_op
	HomDom.category_op
	)

	lemma (in is_functor) is_functor_op'[cat_op_intros]:
	assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
	shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms(1,2) by (rule is_functor_op)

	lemmas is_functor_op[cat_op_intros] = is_functor.is_functor_op'

	lemma (in is_functor) cf_op_cf_op_cf[cat_op_simps]: "op_cf (op_cf \<FF>) = \<FF>"
	proof(rule cf_eqI[of \<alpha> \<AA> \<BB> _ \<AA> \<BB>], unfold cat_op_simps)
	show "op_cf (op_cf \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	metis
	HomCod.cat_op_cat_op_cat
	HomDom.cat_op_cat_op_cat
	is_functor.is_functor_op
	is_functor_op
	)
	qed (auto simp: cat_cs_intros)

	lemmas cf_op_cf_op_cf[cat_op_simps] = is_functor.cf_op_cf_op_cf

	lemma eq_op_cf_iff[cat_op_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "op_cf \<GG> = op_cf \<FF> \<longleftrightarrow> \<GG> = \<FF>"
	proof
	interpret L: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	assume prems: "op_cf \<GG> = op_cf \<FF>"
	show "\<GG> = \<FF>"
	proof(rule cf_eqI[OF assms])
	from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf show
	"\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	by metis+
	from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf have
	"\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by auto
	then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (simp_all add: cat_cs_simps)
	qed
	qed auto



	subsection\<open>Composition of covariant functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	abbreviation (input) cf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>C\<^sub>F" 55)
	where "cf_comp \<equiv> dghm_comp"


	text\<open>Slicing.\<close>

	lemma cf_smcf_smcf_comp[slicing_commute]:
	"cf_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> = cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
	unfolding dghm_comp_def cf_smcf_def dghm_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_comp_ObjMap_vsv[cat_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ObjMap_vsv
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ObjMap_vdomain
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ObjMap_vrange
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ObjMap_app[cat_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ObjMap_app
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma cf_comp_ArrMap_vsv[cat_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ArrMap_vsv
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ArrMap_vdomain
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ArrMap_vrange
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma cf_comp_ArrMap_app[cat_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and [simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_comp_ArrMap_app
	[
	OF L.cf_is_semifunctor R.cf_is_semifunctor,
	unfolded slicing_simps slicing_commute,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma cf_comp_is_functorI[cat_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule is_functorI, unfold dghm_comp_components(3,4))
	show "vfsequence (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)" by (simp add: dghm_comp_def)
	show "vcard (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"
	unfolding dghm_comp_def by (simp add: nat_omega_simps)
	show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding cf_smcf_smcf_comp[symmetric]
	by
	(
	cs_concl
	cs_intro: smc_cs_intros slicing_intros cat_cs_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: cat_cs_simps intro: cat_cs_intros)
	qed

	lemma cf_comp_assoc[cat_cs_simps]:
	assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>C\<^sub>F \<FF> = \<HH> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
	proof(rule cf_eqI[of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
	interpret \<HH>: is_functor \<alpha> \<CC> \<DD> \<HH> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3))
	from \<FF>.is_functor_axioms \<GG>.is_functor_axioms \<HH>.is_functor_axioms
	show "\<HH> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (auto simp: cat_cs_simps intro: cat_cs_intros)
	qed (simp_all add: dghm_comp_components vcomp_assoc)


	text\<open>The opposite of the covariant composition of functors.\<close>

	lemma op_cf_cf_comp[cat_op_simps]: "op_cf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<FF>"
	unfolding dghm_comp_def op_cf_def dghm_field_simps
	by (simp add: nat_omega_simps)


	+text\<open>Composition helper.\<close>
	+
	+lemma cf_comp_assoc_helper:
	+ assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	+ and "\<HH> \<circ>\<^sub>C\<^sub>F \<GG> = \<Q>"
	+ shows "\<HH> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = \<Q> \<circ>\<^sub>C\<^sub>F \<FF>"
	+proof-
	+ interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+ interpret \<HH>: is_functor \<alpha> \<CC> \<DD> \<HH> by (rule assms(3))
	+ show ?thesis
	+ using assms(1-3) unfolding assms(4)[symmetric]
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+qed
	+
	+

	subsection\<open>Composition of contravariant functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>

	definition cf_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<^sub>C\<^sub>F\<circ>" 55)
	where "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> =
	[
	\<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>,
	\<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>,
	op_cat (\<FF>\<lparr>HomDom\<rparr>),
	\<GG>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_cn_comp_components:
	shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
	and [cat_cn_cs_simps]: "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>)"
	and [cat_cn_cs_simps]: "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
	unfolding cf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_cn_comp[slicing_commute]:
	"cf_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> cf_smcf \<FF> = cf_smcf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)"
	unfolding smcf_cn_comp_def cf_cn_comp_def cf_smcf_def
	by (simp add: nat_omega_simps slicing_commute dghm_field_simps)


	subsubsection\<open>Object map: two contravariant functors\<close>

	lemma cf_cn_comp_ObjMap_vsv[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ObjMap_vsv
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ObjMap_vdomain[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ObjMap_vdomain
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ObjMap_vrange
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ObjMap_app[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ObjMap_app
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map: two contravariant functors\<close>

	lemma cf_cn_comp_ArrMap_vsv[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ArrMap_vsv
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ArrMap_vdomain[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ArrMap_vdomain
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ArrMap_vrange
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_comp_ArrMap_app[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_comp_ArrMap_app
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Object map: contravariant and covariant functor\<close>

	lemma cf_cn_cov_comp_ObjMap_vsv[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ObjMap_vsv
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ObjMap_vdomain[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ObjMap_vdomain
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ObjMap_vrange
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ObjMap_app[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ObjMap_app
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map: contravariant and covariant functors\<close>

	lemma cf_cn_cov_comp_ArrMap_vsv[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ArrMap_vsv
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ArrMap_vdomain[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ArrMap_vdomain
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ArrMap_vrange
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma cf_cn_cov_comp_ArrMap_app[cat_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule smcf_cn_cov_comp_ArrMap_app
	[
	OF
	L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
	R.cf_is_semifunctor,
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma cf_cn_comp_is_functorI[cat_cn_cs_intros]:
	assumes "category \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(2))
	interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(3))
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	show ?thesis
	proof(rule is_functorI, unfold cf_cn_comp_components(3,4) cat_op_simps)
	show "vfsequence (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)"
	unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
	show "vcard (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
	unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
	from assms(1) L.cf_is_semifunctor R.cf_is_semifunctor show
	"cf_smcf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding cf_smcf_cf_cn_comp[symmetric]
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros slicing_intros smc_cn_cs_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show
	"(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cat_cn_cs_simps cs_intro: cat_cs_intros
	)
	qed (auto simp: cat_cs_simps cat_cs_intros cat_op_simps)
	qed


	text\<open>See section 1.2 in \cite{bodo_categories_1970}).\<close>

	lemma cf_cn_cov_comp_is_functor[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof
	(
	rule is_functorI,
	unfold cf_cn_comp_components(3,4) cat_op_simps slicing_commute[symmetric]
	)
	show "vfsequence (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)" unfolding cf_cn_comp_def by simp
	show "vcard (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
	unfolding cf_cn_comp_def by (auto simp: nat_omega_simps)
	from L.cf_is_semifunctor show
	"cf_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> cf_smcf \<FF> : op_smc (cat_smc \<AA>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros slicing_intros smc_cs_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_cn_cs_simps
	cs_intro: cat_cs_intros
	)
	qed (auto simp: cat_cs_simps cat_cs_intros)
	qed


	text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>

	lemma cf_cov_cn_comp_is_functor[cat_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by (rule cf_comp_is_functorI)


	text\<open>The opposite of the contravariant composition of functors.\<close>

	lemma op_cf_cf_cn_comp[cat_op_simps]: "op_cf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = op_cf \<GG> \<^sub>C\<^sub>F\<circ> op_cf \<FF>"
	unfolding op_cf_def cf_cn_comp_def dghm_field_simps
	by (auto simp: nat_omega_simps)



	subsection\<open>Identity functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) cf_id :: "V \<Rightarrow> V" where "cf_id \<equiv> dghm_id"


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_id[slicing_commute]: "smcf_id (cat_smc \<CC>) = cf_smcf (cf_id \<CC>)"
	unfolding dghm_id_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
	by (simp add: nat_omega_simps)

	context category
	begin

	interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)

	lemmas_with [unfolded slicing_simps]:
	cat_smcf_id_is_semifunctor = smc.smc_smcf_id_is_semifunctor

	end


	subsubsection\<open>Object map\<close>

	lemmas [cat_cs_simps] = dghm_id_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	lemmas [cat_cs_simps] = dghm_id_ArrMap_app


	subsubsection\<open>Opposite of an identity functor.\<close>

	lemma op_cf_cf_id[cat_op_simps]: "op_cf (cf_id \<CC>) = cf_id (op_cat \<CC>)"
	unfolding dghm_id_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>An identity functor is a functor\<close>

	lemma (in category) cat_cf_id_is_functor: "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule is_functorI, unfold dghm_id_components)
	from cat_smcf_id_is_semifunctor show
	"cf_smcf (cf_id \<CC>) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by (simp add: slicing_commute)
	from cat_CId_is_arr show
	"c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>vid_on (\<CC>\<lparr>Obj\<rparr>)\<lparr>c\<rparr>\<rparr>"
	for c
	by auto
	qed (auto simp: dghm_id_def nat_omega_simps cat_cs_intros)

	lemma (in category) cat_cf_id_is_functor':
	assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
	shows "cf_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule cat_cf_id_is_functor)

	lemmas [cat_cs_intros] = category.cat_cf_id_is_functor'


	subsubsection\<open>Further properties\<close>

	lemma (in is_functor) cf_cf_comp_cf_id_left[cat_cs_simps]: "cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<FF> = \<FF>"
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	by
	(
	rule cf_eqI,
	unfold dghm_id_components dghm_comp_components dghm_id_components
	)
	(auto intro: cat_cs_intros simp: cf_ArrMap_vrange cf_ObjMap_vrange)

	lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_left

	lemma (in is_functor) cf_cf_comp_cf_id_right[cat_cs_simps]: "\<FF> \<circ>\<^sub>C\<^sub>F cf_id \<AA> = \<FF>"
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	by
	(
	rule cf_eqI,
	unfold dghm_id_components dghm_comp_components dghm_id_components
	)
	(
	auto
	intro: cat_cs_intros
	simp: cat_cs_simps cf_ArrMap_vrange cf_ObjMap_vrange
	)

	lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_right



	subsection\<open>Constant functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation cf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_const \<CC> \<DD> a \<equiv> smcf_const \<CC> \<DD> a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>)"


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_const[slicing_commute]:
	"smcf_const (cat_smc \<CC>) (cat_smc \<DD>) a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>) = cf_smcf (cf_const \<CC> \<DD> a)"
	unfolding
	dghm_const_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Object map and arrow map\<close>

	context
	fixes \<DD> a :: V
	begin

	lemmas_with [where \<DD>=\<DD> and a=a and f=\<open>\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<close>, cat_cs_simps]:
	dghm_const_ObjMap_app
	dghm_const_ArrMap_app

	end


	subsubsection\<open>Opposite constant functor\<close>

	lemma op_cf_cf_const[cat_op_simps]:
	"op_cf (cf_const \<CC> \<DD> a) = cf_const (op_cat \<CC>) (op_cat \<DD>) a"
	unfolding dghm_const_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>A constant functor is a functor\<close>

	lemma cf_const_is_functor:
	assumes "category \<alpha> \<CC>" and "category \<alpha> \<DD>" and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	shows "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	show ?thesis
	proof(intro is_functorI, tactic\<open>distinct_subgoals_tac\<close>)
	show "vfsequence (dghm_const \<CC> \<DD> a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>))"
	unfolding dghm_const_def by simp
	show "vcard (cf_const \<CC> \<DD> a) = 4\<^sub>\<nat>"
	unfolding dghm_const_def by (simp add: nat_omega_simps)
	from assms show "cf_smcf (cf_const \<CC> \<DD> a) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<DD>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps slicing_simps slicing_commute[symmetric]
	cs_intro: smc_cs_intros cat_cs_intros slicing_intros
	)
	fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms show
	"cf_const \<CC> \<DD> a\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<DD>\<lparr>CId\<rparr>\<lparr>cf_const \<CC> \<DD> a\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: dghm_const_components assms)
	qed

	lemma cf_const_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	and "f = (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>)"
	shows "dghm_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1-3) unfolding assms(4-6) by (rule cf_const_is_functor)


	subsubsection\<open>Further properties\<close>

	-lemma (in is_functor) cf_cf_comp_cf_const:
	+lemma cf_comp_cf_const_right[cat_cs_simps]:
	+ assumes "category \<alpha> \<AA>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	+proof(rule cf_eqI)
	+
	+ interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+
	+ from assms(3) show "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ from assms(3) show "cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from assms(3) have ObjMap_dom_lhs:
	+ "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from assms(3) have ObjMap_dom_rhs:
	+ "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ObjMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>"
	+ proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ with assms(3) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
	+ cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (auto intro: assms(3) cat_cs_intros)
	+ from assms(3) have ArrMap_dom_lhs:
	+ "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from assms(3) have ArrMap_dom_rhs:
	+ "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ArrMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>"
	+ proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	+ with assms(3) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> =
	+ cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (auto intro: assms(3) cat_cs_intros)
	+
	+qed simp_all
	+
	+lemma cf_comp_cf_const_right'[cat_cs_simps]:
	+ assumes "category \<alpha> \<AA>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ and "f = \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F dghm_const \<AA> \<BB> b f = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	+ using assms(1-3) unfolding assms(4) by (rule cf_comp_cf_const_right)
	+
	+lemma (in is_functor) cf_comp_cf_const_left[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_const \<BB> \<CC> a \<circ>\<^sub>C\<^sub>F \<FF> = cf_const \<AA> \<CC> a"
	proof(rule cf_smcf_eqI)
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	from assms(2) show "cf_const \<BB> \<CC> a \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(2) show "cf_const \<AA> \<CC> a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(2) have CId_a: "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(2) have CId_CId_a: "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from
	is_semifunctor.smcf_smcf_comp_smcf_const
	[
	OF cf_is_semifunctor \<CC>.cat_semicategory,
	unfolded slicing_simps,
	OF CId_a CId_CId_a
	]
	show "cf_smcf (cf_const \<BB> \<CC> a \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = cf_smcf (cf_const \<AA> \<CC> a)"
	by (cs_prems cs_shallow cs_simp: slicing_simps slicing_commute)
	qed simp_all

	-lemma (in is_functor) cf_cf_comp_cf_const'[cat_cs_simps]:
	+lemma (in is_functor) cf_comp_cf_const_left'[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	shows "dghm_const \<BB> \<CC> a f \<circ>\<^sub>C\<^sub>F \<FF> = cf_const \<AA> \<CC> a"
	- using assms(1,2) unfolding assms(3) by (rule cf_cf_comp_cf_const)
	+ using assms(1,2) unfolding assms(3) by (rule cf_comp_cf_const_left)

	-lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_const'
	+lemmas [cat_cs_simps] = is_functor.cf_comp_cf_const_left'



	subsection\<open>Faithful functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_ft_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes ft_cf_is_ft_semifunctor[slicing_intros]:
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

	syntax "_is_ft_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_functor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_ft_functor) ft_cf_is_ft_functor':
	assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ft_cf_is_ft_semifunctor)

	lemmas [slicing_intros] = is_ft_functor.ft_cf_is_ft_functor'


	text\<open>Rules.\<close>

	lemma (in is_ft_functor) is_ft_functor_axioms'[cf_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_ft_functor_axioms)

	mk_ide rf is_ft_functor_def[unfolded is_ft_functor_axioms_def]
	\|intro is_ft_functorI\|
	\|dest is_ft_functorD[dest]\|
	\|elim is_ft_functorE[elim]\|

	lemmas [cf_cs_intros] = is_ft_functorD(1)

	lemma is_ft_functorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_ft_functorI)
	(
	simp_all add:
	assms(1)
	is_ft_semifunctorI'[OF is_functorD(6)[
	OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_ft_functorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	by
	(
	simp_all add:
	is_ft_functorD[OF assms(1)]
	is_ft_semifunctorD'(2)[
	OF is_ft_functorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_ft_functorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	using assms by (simp_all add: is_ft_functorD')

	+lemma is_ft_functorI'':
	+ assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<And>a b g f.
	+ \<lbrakk> g : a \<mapsto>\<^bsub>\<AA>\<^esub> b; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b; \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<rbrakk> \<Longrightarrow> g = f"
	+ shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ intro is_ft_functorI assms,
	+ rule is_ft_semifunctorI'',
	+ unfold slicing_simps,
	+ rule is_functor.cf_is_semifunctor[OF assms(1)],
	+ rule assms(2)
	+ )
	+

	text\<open>Elementary properties.\<close>

	context is_ft_functor
	begin

	interpretation smcf: is_ft_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule ft_cf_is_ft_semifunctor)

	lemmas_with [unfolded slicing_simps]:
	ft_cf_v11_on_Hom = smcf.ft_smcf_v11_on_Hom
	+ and ft_cf_ArrMap_eqD = smcf.ft_smcf_ArrMap_eqD

	end


	subsubsection\<open>Opposite faithful functor.\<close>

	lemma (in is_ft_functor) is_ft_functor_op':
	"op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (rule is_ft_functorI, unfold slicing_commute[symmetric])
	(
	simp_all add:
	is_functor_op is_ft_semifunctor.is_ft_semifunctor_op
	ft_cf_is_ft_semifunctor
	)

	lemma (in is_ft_functor) is_ft_functor_op:
	assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
	shows "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	unfolding assms by (rule is_ft_functor_op')

	lemmas is_ft_functor_op[cat_op_intros] = is_ft_functor.is_ft_functor_op'


	subsubsection\<open>The composition of faithful functors is a faithful functor\<close>

	lemma cf_comp_is_ft_functor[cf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_ft_functorI)
	interpret \<GG>: is_ft_functor \<alpha> \<BB> \<CC> \<GG> by (simp add: assms(1))
	interpret \<FF>: is_ft_functor \<alpha> \<AA> \<BB> \<FF> by (simp add: assms(2))
	from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	then interpret is_functor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> .
	show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
	)
	qed



	subsection\<open>Full functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_fl_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes fl_cf_is_fl_semifunctor:
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

	syntax "_is_fl_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_functor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_fl_functor) fl_cf_is_fl_functor'[slicing_intros]:
	assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule fl_cf_is_fl_semifunctor)

	lemmas [slicing_intros] = is_fl_functor.fl_cf_is_fl_semifunctor


	text\<open>Rules.\<close>

	lemma (in is_fl_functor) is_fl_functor_axioms'[cf_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_fl_functor_axioms)

	mk_ide rf is_fl_functor_def[unfolded is_fl_functor_axioms_def]
	\|intro is_fl_functorI\|
	\|dest is_fl_functorD[dest]\|
	\|elim is_fl_functorE[elim]\|

	lemmas [cf_cs_intros] = is_fl_functorD(1)

	lemma is_fl_functorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_fl_functorI)
	(
	simp_all add:
	assms(1)
	is_fl_semifunctorI'[
	OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_fl_functorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	simp_all add:
	is_fl_functorD[OF assms(1)]
	is_fl_semifunctorD'(2)[
	OF is_fl_functorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_fl_functorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	using assms by (simp_all add: is_fl_functorD')


	text\<open>Elementary properties.\<close>

	context is_fl_functor
	begin

	interpretation smcf: is_fl_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule fl_cf_is_fl_semifunctor)

	lemmas_with [unfolded slicing_simps]:
	fl_cf_surj_on_Hom = smcf.fl_smcf_surj_on_Hom

	end


	subsubsection\<open>Opposite full functor\<close>

	lemma (in is_fl_functor) is_fl_functor_op[cat_op_intros]:
	"op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (rule is_fl_functorI, unfold slicing_commute[symmetric])
	(simp_all add: cat_op_intros smc_op_intros slicing_intros)

	lemmas is_fl_functor_op[cat_op_intros] = is_fl_functor.is_fl_functor_op


	subsubsection\<open>The composition of full functor is a full functor\<close>

	lemma cf_comp_is_fl_functor[cf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_fl_functorI)
	interpret \<FF>: is_fl_functor \<alpha> \<AA> \<BB> \<FF> using assms(2) by simp
	interpret \<GG>: is_fl_functor \<alpha> \<BB> \<CC> \<GG> using assms(1) by simp
	from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
	)
	qed



	subsection\<open>Fully faithful functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_ff_functor = is_ft_functor \<alpha> \<AA> \<BB> \<FF> + is_fl_functor \<alpha> \<AA> \<BB> \<FF>
	for \<alpha> \<AA> \<BB> \<FF>

	syntax "_is_ff_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_functor \<alpha> \<AA> \<BB> \<FF>"


	text\<open>Rules.\<close>

	mk_ide rf is_ff_functor_def
	\|intro is_ff_functorI\|
	\|dest is_ff_functorD[dest]\|
	\|elim is_ff_functorE[elim]\|

	lemmas [cf_cs_intros] = is_ff_functorD


	text\<open>Elementary properties.\<close>

	lemma (in is_ff_functor) ff_cf_is_ff_semifunctor:
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	by (rule is_ff_semifunctorI) (auto intro: slicing_intros)

	lemma (in is_ff_functor) ff_cf_is_ff_semifunctor'[slicing_intros]:
	assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ff_cf_is_ff_semifunctor)

	lemmas [slicing_intros] = is_ff_functor.ff_cf_is_ff_semifunctor'


	subsubsection\<open>Opposite fully faithful functor\<close>

	lemma (in is_ff_functor) is_ff_functor_op:
	"op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (rule is_ff_functorI) (auto simp: is_fl_functor_op is_ft_functor_op)

	lemma (in is_ff_functor) is_ff_functor_op'[cat_op_intros]:
	assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
	shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_ff_functor_op)

	lemmas is_ff_functor_op[cat_op_intros] = is_ff_functor.is_ff_functor_op


	subsubsection\<open>
	The composition of fully faithful functors is a fully faithful functor
	\<close>

	lemma cf_comp_is_ff_functor[cf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms
	by (intro is_ff_functorI, elim is_ff_functorE) (auto simp: cf_cs_intros)



	subsection\<open>Isomorphism of categories\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_iso_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes iso_cf_is_iso_semifunctor:
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

	syntax "_is_iso_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_functor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_iso_functor) iso_cf_is_iso_semifunctor'[slicing_intros]:
	assumes "\<AA>' = cat_smc \<AA>" "\<BB>' = cat_smc \<BB>"
	shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule iso_cf_is_iso_semifunctor)

	lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'


	text\<open>Rules.\<close>

	lemma (in is_iso_functor) is_iso_functor_axioms'[cf_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_functor_axioms)

	mk_ide rf is_iso_functor_def[unfolded is_iso_functor_axioms_def]
	\|intro is_iso_functorI\|
	\|dest is_iso_functorD[dest]\|
	\|elim is_iso_functorE[elim]\|

	lemma is_iso_functorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_iso_functorI)
	(
	simp_all add:
	assms(1)
	is_iso_semifunctorI'[
	OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_iso_functorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by
	(
	simp_all add:
	is_iso_functorD[OF assms(1)]
	is_iso_semifunctorD'(2-5)[
	OF is_iso_functorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_iso_functorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	using assms by (simp_all add: is_iso_functorD')


	text\<open>Elementary properties.\<close>

	context is_iso_functor
	begin

	interpretation smcf: is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule iso_cf_is_iso_semifunctor)

	lemmas_with [unfolded slicing_simps]:
	iso_cf_ObjMap_vrange[simp] = smcf.iso_smcf_ObjMap_vrange
	and iso_cf_ArrMap_vrange[simp] = smcf.iso_smcf_ArrMap_vrange

	sublocale ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (rule smcf.ObjMap.v11_axioms[unfolded slicing_simps])
	(simp_all add: cat_cs_simps cf_cs_simps)

	sublocale ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by (rule smcf.ArrMap.v11_axioms[unfolded slicing_simps])
	(simp_all add: cat_cs_simps smcf_cs_simps)

	lemmas_with [unfolded slicing_simps]:
	iso_cf_Obj_HomDom_if_Obj_HomCod[elim] =
	smcf.iso_smcf_Obj_HomDom_if_Obj_HomCod
	and iso_cf_Arr_HomDom_if_Arr_HomCod[elim] =
	smcf.iso_smcf_Arr_HomDom_if_Arr_HomCod
	and iso_cf_ObjMap_eqE[elim] = smcf.iso_smcf_ObjMap_eqE
	and iso_cf_ArrMap_eqE[elim] = smcf.iso_smcf_ArrMap_eqE

	end

	sublocale is_iso_functor \<subseteq> is_ff_functor
	proof(intro is_ff_functorI)
	interpret is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule iso_cf_is_iso_semifunctor)
	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
	qed

	lemmas (in is_iso_functor) iso_cf_is_ff_functor = is_ff_functor_axioms
	lemmas [cf_cs_intros] = is_iso_functor.iso_cf_is_ff_functor


	subsubsection\<open>Opposite isomorphism of categories\<close>

	lemma (in is_iso_functor) is_iso_functor_op:
	"op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (rule is_iso_functorI, unfold slicing_simps slicing_commute[symmetric])
	(simp_all add: cat_op_intros smc_op_intros slicing_intros)

	lemma (in is_iso_functor) is_iso_functor_op':
	assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
	shows "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	unfolding assms by (rule is_iso_functor_op)

	lemmas is_iso_functor_op[cat_op_intros] =
	is_iso_functor.is_iso_functor_op'


	subsubsection\<open>
	The composition of isomorphisms of categories is an isomorphism of categories
	\<close>

	lemma cf_comp_is_iso_functor[cf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_iso_functorI)
	interpret \<FF>: is_iso_functor \<alpha> \<AA> \<BB> \<FF> using assms by auto
	interpret \<GG>: is_iso_functor \<alpha> \<BB> \<CC> \<GG> using assms by auto
	from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding slicing_commute[symmetric]
	by (cs_concl cs_shallow cs_intro: smcf_cs_intros slicing_intros)
	qed



	subsection\<open>Inverse functor\<close>

	abbreviation (input) inv_cf :: "V \<Rightarrow> V"
	where "inv_cf \<equiv> inv_dghm"


	text\<open>Slicing.\<close>

	lemma dghm_inv_semifunctor[slicing_commute]:
	"inv_smcf (cf_smcf \<FF>) = cf_smcf (inv_cf \<FF>)"
	unfolding cf_smcf_def inv_dghm_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	context is_iso_functor
	begin

	interpretation smcf: is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
	by (rule iso_cf_is_iso_semifunctor)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	inv_cf_ObjMap_v11 = smcf.inv_smcf_ObjMap_v11
	and inv_cf_ObjMap_vdomain = smcf.inv_smcf_ObjMap_vdomain
	and inv_cf_ObjMap_app = smcf.inv_smcf_ObjMap_app
	and inv_cf_ObjMap_vrange = smcf.inv_smcf_ObjMap_vrange
	and inv_cf_ArrMap_v11 = smcf.inv_smcf_ArrMap_v11
	and inv_cf_ArrMap_vdomain = smcf.inv_smcf_ArrMap_vdomain
	and inv_cf_ArrMap_app = smcf.inv_smcf_ArrMap_app
	and inv_cf_ArrMap_vrange = smcf.inv_smcf_ArrMap_vrange
	- and iso_cf_ObjMap_inv_cf_ObjMap_app =
	+ and iso_cf_ObjMap_inv_cf_ObjMap_app[cf_cs_simps] =
	smcf.iso_smcf_ObjMap_inv_smcf_ObjMap_app
	- and iso_cf_ArrMap_inv_cf_ArrMap_app =
	+ and iso_cf_ArrMap_inv_cf_ArrMap_app[cf_cs_simps] =
	smcf.iso_smcf_ArrMap_inv_smcf_ArrMap_app
	and iso_cf_HomDom_is_arr_conv = smcf.iso_smcf_HomDom_is_arr_conv
	and iso_cf_HomCod_is_arr_conv = smcf.iso_smcf_HomCod_is_arr_conv
	+ and iso_inv_cf_ObjMap_cf_ObjMap_app[cf_cs_simps] =
	+ smcf.iso_inv_smcf_ObjMap_smcf_ObjMap_app
	+ and iso_inv_cf_ArrMap_cf_ArrMap_app[cf_cs_simps] =
	+ smcf.iso_inv_smcf_ArrMap_smcf_ArrMap_app

	end

	+lemmas [cf_cs_intros] =
	+ is_iso_functor.inv_cf_ObjMap_v11
	+ is_iso_functor.inv_cf_ArrMap_v11
	+
	+lemmas [cf_cs_simps] =
	+ is_iso_functor.inv_cf_ObjMap_vdomain
	+ is_iso_functor.inv_cf_ObjMap_app
	+ is_iso_functor.inv_cf_ObjMap_vrange
	+ is_iso_functor.inv_cf_ArrMap_vdomain
	+ is_iso_functor.inv_cf_ArrMap_app
	+ is_iso_functor.inv_cf_ArrMap_vrange
	+ is_iso_functor.iso_cf_ObjMap_inv_cf_ObjMap_app
	+ is_iso_functor.iso_cf_ArrMap_inv_cf_ArrMap_app
	+ is_iso_functor.iso_inv_cf_ObjMap_cf_ObjMap_app
	+ is_iso_functor.iso_inv_cf_ArrMap_cf_ArrMap_app
	+


	subsection\<open>An isomorphism of categories is an isomorphism in the category \<open>CAT\<close>\<close>

	-lemma is_arr_isomorphism_is_iso_functor:
	+lemma is_iso_arr_is_iso_functor:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
	and "\<FF> \<circ>\<^sub>C\<^sub>F \<GG> = cf_id \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
	show ?thesis
	proof(rule is_iso_functorI)
	have \<GG>\<FF>\<AA>: "cf_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> = smcf_id (cat_smc \<AA>)"
	by (simp add: assms(3) cf_smcf_cf_id cf_smcf_smcf_comp)
	have \<FF>\<GG>\<BB>: "cf_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> = smcf_id (cat_smc \<BB>)"
	by (simp add: assms(4) cf_smcf_cf_id cf_smcf_smcf_comp)
	from \<FF>.cf_is_semifunctor \<GG>.cf_is_semifunctor \<GG>\<FF>\<AA> \<FF>\<GG>\<BB> show
	"cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	- by (rule is_arr_isomorphism_is_iso_semifunctor)
	+ by (rule is_iso_arr_is_iso_semifunctor)
	qed (auto simp: cat_cs_intros)
	qed

	-lemma is_iso_functor_is_arr_isomorphism:
	+lemma is_iso_functor_is_iso_arr:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [cf_cs_intros]: "inv_cf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	- and "inv_cf \<FF> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
	- and "\<FF> \<circ>\<^sub>C\<^sub>F inv_cf \<FF> = cf_id \<BB>"
	+ and [cf_cs_simps]: "inv_cf \<FF> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
	+ and [cf_cs_simps]: "\<FF> \<circ>\<^sub>C\<^sub>F inv_cf \<FF> = cf_id \<BB>"
	proof-

	let ?\<GG> = "inv_cf \<FF>"

	interpret is_iso_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))

	show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_iso_functorI is_functorI, unfold inv_dghm_components)
	show "vfsequence ?\<GG>" by (simp add: inv_dghm_def)
	show "vcard ?\<GG> = 4\<^sub>\<nat>"
	unfolding inv_dghm_def by (simp add: nat_omega_simps)
	show "cf_smcf ?\<GG> : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
	by
	(
	metis
	dghm_inv_semifunctor
	iso_cf_is_iso_semifunctor
	is_iso_semifunctor_def
	- is_iso_semifunctor_is_arr_isomorphism(1)
	+ is_iso_semifunctor_is_iso_arr(1)
	)
	show "cf_smcf ?\<GG> : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
	by
	(
	metis
	dghm_inv_semifunctor
	iso_cf_is_iso_semifunctor
	- is_iso_semifunctor_is_arr_isomorphism(1)
	+ is_iso_semifunctor_is_iso_arr(1)
	)
	fix c assume prems: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	from prems show "(\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>(\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>\<lparr>c\<rparr>\<rparr>"
	by (intro v11.v11_vconverse_app)
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros V_cs_intros
	cs_simp: V_cs_simps cat_cs_simps
	)+
	qed (simp_all add: cat_cs_simps cat_cs_intros)

	show "?\<GG> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
	proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
	from \<GG> is_functor_axioms show "?\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (blast intro: cat_cs_intros)
	qed
	(
	simp_all add:
	HomDom.cat_cf_id_is_functor
	ObjMap.v11_vcomp_vconverse
	ArrMap.v11_vcomp_vconverse
	dghm_id_components
	)

	show "\<FF> \<circ>\<^sub>C\<^sub>F ?\<GG> = cf_id \<BB>"
	proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
	from \<GG> is_functor_axioms show "\<FF> \<circ>\<^sub>C\<^sub>F ?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (blast intro: cat_cs_intros)
	show "cf_id \<BB> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (simp add: HomCod.cat_cf_id_is_functor)
	qed
	(
	simp_all add:
	ObjMap.v11_vcomp_vconverse'
	ArrMap.v11_vcomp_vconverse'
	dghm_id_components
	)

	qed


	subsubsection\<open>An identity functor is an isomorphism of categories\<close>

	lemma (in category) cat_cf_id_is_iso_functor: "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule is_iso_functorI, unfold slicing_commute[symmetric])
	(
	simp_all add:
	cat_cf_id_is_functor
	semicategory.smc_smcf_id_is_iso_semifunctor
	cat_semicategory
	)



	subsection\<open>Isomorphic categories\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale iso_category = L: category \<alpha> \<AA> + R: category \<alpha> \<BB> for \<alpha> \<AA> \<BB> +
	assumes iso_cat_is_iso_functor: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"

	notation iso_category (infixl "\<approx>\<^sub>C\<index>" 50)


	text\<open>Rules.\<close>

	lemma iso_categoryI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_category_def iso_category_axioms_def by auto

	lemma iso_categoryD[dest]:
	assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_category_def iso_category_axioms_def by simp_all

	lemma iso_categoryE[elim]:
	assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by auto


	text\<open>Isomorphic categories are isomorphic semicategories.\<close>

	lemma (in iso_category) iso_cat_iso_semicategory:
	"cat_smc \<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	using iso_cat_is_iso_functor
	by (auto intro: slicing_intros iso_semicategoryI)


	subsubsection\<open>A category isomorphism is an equivalence relation\<close>

	lemma iso_category_refl:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule iso_categoryI[of _ _ _ \<open>cf_id \<AA>\<close>])
	interpret category \<alpha> \<AA> by (rule assms)
	show "cf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" by (simp add: cat_cf_id_is_iso_functor)
	qed

	lemma iso_category_sym[sym]:
	assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<BB> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret iso_category \<alpha> \<AA> \<BB> by (rule assms)
	from iso_cat_is_iso_functor obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
	- from is_iso_functor_is_arr_isomorphism(1)[OF this] show ?thesis
	+ from is_iso_functor_is_iso_arr(1)[OF this] show ?thesis
	by (auto intro: iso_categoryI)
	qed

	lemma iso_category_trans[trans]:
	assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: iso_category \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret R: iso_category \<alpha> \<BB> \<CC> by (rule assms(2))
	from L.iso_cat_is_iso_functor R.iso_cat_is_iso_functor show ?thesis
	by (auto intro: iso_categoryI is_iso_functorI cf_comp_is_iso_functor)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_GRPH.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_GRPH.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_GRPH.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_GRPH.thy
	@@ -1,251 +1,251 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>GRPH\<close>\<close>
	theory CZH_ECAT_GRPH
	imports
	CZH_ECAT_Small_Category
	CZH_Foundations.CZH_SMC_GRPH
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology for the exposition of \<open>GRPH\<close> as a category is analogous to
	the one used in \cite{milehins_category_2021}
	for the exposition of \<open>GRPH\<close> as a semicategory.
	\<close>

	named_theorems cat_GRPH_simps
	named_theorems cat_GRPH_intros



	subsection\<open>Definition and elementary properties\<close>

	definition cat_GRPH :: "V \<Rightarrow> V"
	where "cat_GRPH \<alpha> =
	[
	set {\<CC>. digraph \<alpha> \<CC>},
	all_dghms \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>),
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_GRPH \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. digraph \<alpha> \<CC>}. dghm_id \<CC>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_GRPH_components:
	shows "cat_GRPH \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. digraph \<alpha> \<CC>}"
	and "cat_GRPH \<alpha>\<lparr>Arr\<rparr> = all_dghms \<alpha>"
	and "cat_GRPH \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "cat_GRPH \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	and "cat_GRPH \<alpha>\<lparr>Comp\<rparr> =
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_GRPH \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_GRPH \<alpha>\<lparr>CId\<rparr> = (\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. digraph \<alpha> \<CC>}. dghm_id \<CC>)"
	unfolding cat_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_GRPH: "cat_smc (cat_GRPH \<alpha>) = smc_GRPH \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_GRPH \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_GRPH \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_GRPH_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_GRPH \<alpha>)) = \<D>\<^sub>\<circ> (smc_GRPH \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show
	"a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_GRPH \<alpha>)) \<Longrightarrow> cat_smc (cat_GRPH \<alpha>)\<lparr>a\<rparr> = smc_GRPH \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_GRPH_def smc_GRPH_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: cat_smc_def smc_GRPH_def)

	lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps]:
	\<comment>\<open>Digraph\<close>
	cat_GRPH_ObjI = smc_GRPH_ObjI
	and cat_GRPH_ObjD = smc_GRPH_ObjD
	and cat_GRPH_ObjE = smc_GRPH_ObjE
	and cat_GRPH_Obj_iff[cat_GRPH_simps] = smc_GRPH_Obj_iff
	and cat_GRPH_Dom_app[cat_GRPH_simps] = smc_GRPH_Dom_app
	and cat_GRPH_Cod_app[cat_GRPH_simps] = smc_GRPH_Cod_app
	and cat_GRPH_is_arrI = smc_GRPH_is_arrI
	and cat_GRPH_is_arrD = smc_GRPH_is_arrD
	and cat_GRPH_is_arrE = smc_GRPH_is_arrE
	and cat_GRPH_is_arr_iff[cat_GRPH_simps] = smc_GRPH_is_arr_iff

	lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps, unfolded cat_smc_GRPH]:
	\<comment>\<open>Semicategory\<close>
	cat_GRPH_Comp_vdomain = smc_GRPH_Comp_vdomain
	and cat_GRPH_composable_arrs_dg_GRPH = smc_GRPH_composable_arrs_dg_GRPH
	and cat_GRPH_Comp = smc_GRPH_Comp
	and cat_GRPH_Comp_app[cat_GRPH_simps] = smc_GRPH_Comp_app

	lemmas_with (in \<Z>) [folded cat_smc_GRPH, unfolded slicing_simps]:
	\<comment>\<open>Semicategory\<close>
	cat_GRPH_obj_initialI = smc_GRPH_obj_initialI
	and cat_GRPH_obj_initialD = smc_GRPH_obj_initialD
	and cat_GRPH_obj_initialE = smc_GRPH_obj_initialE
	and cat_GRPH_obj_initial_iff[cat_GRPH_simps] = smc_GRPH_obj_initial_iff
	and cat_GRPH_obj_terminalI = smc_GRPH_obj_terminalI
	and cat_GRPH_obj_terminalE = smc_GRPH_obj_terminalE


	subsection\<open>Identity\<close>

	lemma cat_GRPH_CId_app[cat_GRPH_simps]:
	assumes "digraph \<alpha> \<CC>"
	shows "cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<CC>\<rparr> = dghm_id \<CC>"
	using assms unfolding cat_GRPH_components by simp

	lemma cat_GRPH_CId_vdomain: "\<D>\<^sub>\<circ> (cat_GRPH \<alpha>\<lparr>CId\<rparr>) = set {\<CC>. digraph \<alpha> \<CC>}"
	unfolding cat_GRPH_components by auto

	lemma cat_GRPH_CId_vrange: "\<R>\<^sub>\<circ> (cat_GRPH \<alpha>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> all_dghms \<alpha>"
	proof(rule vsubsetI)
	fix \<HH> assume "\<HH> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (cat_GRPH \<alpha>\<lparr>CId\<rparr>)"
	then obtain \<AA>
	where \<HH>_def: "\<HH> = cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>" and \<AA>: "\<AA> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_GRPH \<alpha>\<lparr>CId\<rparr>)"
	unfolding cat_GRPH_components by auto
	from \<AA> have \<HH>_def': "\<HH> = dghm_id \<AA>"
	unfolding \<HH>_def cat_GRPH_CId_vdomain by (auto simp: cat_GRPH_CId_app)
	from \<AA> digraph.dg_dghm_id_is_dghm show "\<HH> \<in>\<^sub>\<circ> all_dghms \<alpha>"
	unfolding \<HH>_def' cat_GRPH_CId_vdomain by force
	qed



	subsection\<open>\<open>GRPH\<close> is a category\<close>

	lemma (in \<Z>) tiny_category_cat_GRPH:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_category \<beta> (cat_GRPH \<alpha>)"
	proof(intro tiny_categoryI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "vfsequence (cat_GRPH \<alpha>)" unfolding cat_GRPH_def by simp
	show "vcard (cat_GRPH \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_GRPH_def by (simp add: nat_omega_simps)
	show "cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> \<FF> = \<FF>"
	if "\<FF> : \<AA> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>" for \<FF> \<AA> \<BB>
	using that
	unfolding cat_GRPH_is_arr_iff
	by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
	show "\<FF> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> = \<FF>"
	if "\<FF> : \<BB> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<CC>" for \<FF> \<BB> \<CC>
	using that
	unfolding cat_GRPH_is_arr_iff
	by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
	qed
	(
	simp_all add:
	assms
	cat_smc_GRPH
	cat_GRPH_components
	digraph.dg_dghm_id_is_dghm
	cat_GRPH_is_arr_iff
	tiny_semicategory_smc_GRPH
	)



	subsection\<open>Isomorphism\<close>

	-lemma (in \<Z>) cat_GRPH_is_arr_isomorphismI:
	+lemma cat_GRPH_is_iso_arrI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	from assms show \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	unfolding cat_GRPH_is_arr_iff by auto
	- note iso_thms = is_iso_dghm_is_arr_isomorphism[OF assms]
	+ note iso_thms = is_iso_dghm_is_iso_arr[OF assms]
	from iso_thms(1) show inv_\<FF>: "inv_dghm \<FF> : \<BB> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<AA>"
	unfolding cat_GRPH_is_arr_iff by auto
	from assms show "\<FF> : \<AA> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	unfolding cat_GRPH_is_arr_iff by auto
	from assms have \<AA>: "digraph \<alpha> \<AA>" and \<BB>: "digraph \<alpha> \<BB>" by auto
	show "inv_dghm \<FF> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> \<FF> = cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>"
	unfolding cat_GRPH_CId_app[OF \<AA>] cat_GRPH_Comp_app[OF inv_\<FF> \<FF>]
	by (rule iso_thms(2))
	show "\<FF> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> inv_dghm \<FF> = cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr>"
	unfolding cat_GRPH_CId_app[OF \<BB>] cat_GRPH_Comp_app[OF \<FF> inv_\<FF>]
	by (rule iso_thms(3))
	qed

	-lemma (in \<Z>) cat_GRPH_is_arr_isomorphismD:
	+lemma cat_GRPH_is_iso_arrD:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	- from is_arr_isomorphismD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	+ from is_iso_arrD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	and "(\<exists>\<GG>. is_inverse (cat_GRPH \<alpha>) \<GG> \<FF>)"
	by simp_all
	then obtain \<GG> where \<GG>\<FF>: "is_inverse (cat_GRPH \<alpha>) \<GG> \<FF>" by clarsimp
	then obtain \<AA>' \<BB>' where \<GG>': "\<GG> : \<BB>' \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<AA>'"
	and \<FF>': "\<FF> : \<AA>' \<mapsto>\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>'"
	and \<GG>\<FF>: "\<GG> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> \<FF> = cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>'\<rparr>"
	and \<FF>\<GG>: "\<FF> \<circ>\<^sub>A\<^bsub>cat_GRPH \<alpha>\<^esub> \<GG> = cat_GRPH \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>'\<rparr>"
	by auto
	from \<FF> \<FF>' have \<AA>': "\<AA>' = \<AA>" and \<BB>': "\<BB>' = \<BB>" by auto
	from \<FF> have \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" unfolding cat_GRPH_is_arr_iff by simp
	then have \<AA>: "digraph \<alpha> \<AA>" and \<BB>: "digraph \<alpha> \<BB>" by auto
	from \<GG>' have "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	unfolding \<AA>' \<BB>' cat_GRPH_is_arr_iff by simp
	moreover from \<GG>\<FF> have "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
	unfolding \<AA>' cat_GRPH_Comp_app[OF \<GG>' \<FF>'] cat_GRPH_CId_app[OF \<AA>] by simp
	moreover from \<FF>\<GG> have "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> = dghm_id \<BB>"
	unfolding \<BB>' cat_GRPH_Comp_app[OF \<FF>' \<GG>'] cat_GRPH_CId_app[OF \<BB>] by simp
	- ultimately show ?thesis using \<FF> by (elim is_arr_isomorphism_is_iso_dghm)
	+ ultimately show ?thesis using \<FF> by (elim is_iso_arr_is_iso_dghm)
	qed

	-lemma (in \<Z>) cat_GRPH_is_arr_isomorphismE:
	+lemma cat_GRPH_is_iso_arrE:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using assms by (auto dest: cat_GRPH_is_arr_isomorphismD)
	+ using assms by (auto dest: cat_GRPH_is_iso_arrD)

	-lemma (in \<Z>) cat_GRPH_is_arr_isomorphism_iff[cat_GRPH_simps]:
	+lemma cat_GRPH_is_iso_arr_iff[cat_GRPH_simps]:
	"\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using cat_GRPH_is_arr_isomorphismI cat_GRPH_is_arr_isomorphismD by auto
	+ using cat_GRPH_is_iso_arrI cat_GRPH_is_iso_arrD by auto



	subsection\<open>Isomorphic objects\<close>

	-lemma (in \<Z>) cat_GRPH_obj_isoI:
	+lemma cat_GRPH_obj_isoI:
	assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	proof-
	from iso_digraphD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_GRPH_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
	+ from cat_GRPH_is_iso_arrI[OF this] show ?thesis by (rule obj_isoI)
	qed

	-lemma (in \<Z>) cat_GRPH_obj_isoD:
	+lemma cat_GRPH_obj_isoD:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	from obj_isoD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_GRPH_is_arr_isomorphismD[OF this] show ?thesis
	+ from cat_GRPH_is_iso_arrD[OF this] show ?thesis
	by (rule iso_digraphI)
	qed

	-lemma (in \<Z>) cat_GRPH_obj_isoE:
	+lemma cat_GRPH_obj_isoE:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB>"
	obtains "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (auto simp: cat_GRPH_obj_isoD)

	-lemma (in \<Z>) cat_GRPH_obj_iso_iff: "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	+lemma cat_GRPH_obj_iso_iff: "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_GRPH \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using cat_GRPH_obj_isoI cat_GRPH_obj_isoD by (intro iffI) auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Introduction.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Introduction.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Introduction.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Introduction.thy
	@@ -1,41 +1,40 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Introduction\<close>
	theory CZH_ECAT_Introduction
	imports CZH_Foundations.CZH_DG_Introduction
	begin



	subsection\<open>Background\<close>


	text\<open>
	This article provides a
	formalization of the elementary theory of 1-categories without
	an additional structure. For further information see
	chapter Introduction in \cite{milehins_category_2021}.
	\<close>



	subsection\<open>Preliminaries\<close>

	named_theorems cat_op_simps
	named_theorems cat_op_intros

	named_theorems cat_cs_simps
	named_theorems cat_cs_intros

	named_theorems cat_arrow_cs_intros



	subsection\<open>CS setup for foundations\<close>

	-lemmas (in \<Z>) [cat_cs_intros] =
	- \<Z>_\<beta>
	+lemmas (in \<Z>) [cat_cs_intros] = \<Z>_\<beta>

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
	@@ -1,2401 +1,2514 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Natural transformation\<close>
	theory CZH_ECAT_NTCF
	imports
	CZH_Foundations.CZH_SMC_NTSMCF
	CZH_ECAT_Functor
	begin



	subsection\<open>Background\<close>

	named_theorems ntcf_cs_simps
	named_theorems ntcf_cs_intros

	lemmas [cat_cs_simps] = dg_shared_cs_simps
	lemmas [cat_cs_intros] = dg_shared_cs_intros


	subsubsection\<open>Slicing\<close>

	definition ntcf_ntsmcf :: "V \<Rightarrow> V"
	where "ntcf_ntsmcf \<NN> =
	[
	\<NN>\<lparr>NTMap\<rparr>,
	cf_smcf (\<NN>\<lparr>NTDom\<rparr>),
	cf_smcf (\<NN>\<lparr>NTCod\<rparr>),
	cat_smc (\<NN>\<lparr>NTDGDom\<rparr>),
	cat_smc (\<NN>\<lparr>NTDGCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_ntsmcf_components:
	shows [slicing_simps]: "ntcf_ntsmcf \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDom\<rparr> = cf_smcf (\<NN>\<lparr>NTDom\<rparr>)"
	and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTCod\<rparr> = cf_smcf (\<NN>\<lparr>NTCod\<rparr>)"
	and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDGDom\<rparr> = cat_smc (\<NN>\<lparr>NTDGDom\<rparr>)"
	and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDGCod\<rparr> = cat_smc (\<NN>\<lparr>NTDGCod\<rparr>)"
	unfolding ntcf_ntsmcf_def nt_field_simps by (auto simp: nat_omega_simps)



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	The definition of a natural transformation that is used in this work is
	is similar to the definition that can be found in Chapter I-4 in
	\cite{mac_lane_categories_2010}.
	\<close>

	locale is_ntcf =
	\<Z> \<alpha> +
	vfsequence \<NN> +
	NTDom: is_functor \<alpha> \<AA> \<BB> \<FF> +
	NTCod: is_functor \<alpha> \<AA> \<BB> \<GG>
	for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
	assumes ntcf_length[cat_cs_simps]: "vcard \<NN> = 5\<^sub>\<nat>"
	and ntcf_is_ntsmcf[slicing_intros]: "ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	and ntcf_NTDom[cat_cs_simps]: "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
	and ntcf_NTCod[cat_cs_simps]: "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
	and ntcf_NTDGDom[cat_cs_simps]: "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	and ntcf_NTDGCod[cat_cs_simps]: "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"

	syntax "_is_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

	abbreviation all_ntcfs :: "V \<Rightarrow> V"
	where "all_ntcfs \<alpha> \<equiv> set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcfs \<alpha> \<AA> \<BB> \<equiv> set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation these_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv> set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemmas [cat_cs_simps] =
	is_ntcf.ntcf_length
	is_ntcf.ntcf_NTDom
	is_ntcf.ntcf_NTCod
	is_ntcf.ntcf_NTDGDom
	is_ntcf.ntcf_NTDGCod

	lemma (in is_ntcf) ntcf_is_ntsmcf':
	assumes "\<FF>' = cf_smcf \<FF>"
	and "\<GG>' = cf_smcf \<GG>"
	and "\<AA>' = cat_smc \<AA>"
	and "\<BB>' = cat_smc \<BB>"
	shows "ntcf_ntsmcf \<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms(1-4) by (rule ntcf_is_ntsmcf)

	lemmas [slicing_intros] = is_ntcf.ntcf_is_ntsmcf'


	text\<open>Rules.\<close>

	lemma (in is_ntcf) is_ntcf_axioms'[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
	shows "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_ntcf_axioms)

	mk_ide rf is_ntcf_def[unfolded is_ntcf_axioms_def]
	\|intro is_ntcfI\|
	\|dest is_ntcfD[dest]\|
	\|elim is_ntcfE[elim]\|

	lemmas [cat_cs_intros] =
	is_ntcfD(3,4)

	lemma is_ntcfI':
	assumes "\<Z> \<alpha>"
	and "vfsequence \<NN>"
	and "vcard \<NN> = 5\<^sub>\<nat>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
	and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
	and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
	and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_ntcfI is_ntsmcfI', unfold ntcf_ntsmcf_components slicing_simps)
	(
	simp_all add:
	assms nat_omega_simps
	ntcf_ntsmcf_def
	is_functorD(6)[OF assms(4)]
	is_functorD(6)[OF assms(5)]
	)

	lemma is_ntcfD':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<Z> \<alpha>"
	and "vfsequence \<NN>"
	and "vcard \<NN> = 5\<^sub>\<nat>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
	and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
	and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
	and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	simp_all add:
	is_ntcfD(2-10)[OF assms]
	is_ntsmcfD'[OF is_ntcfD(6)[OF assms], unfolded slicing_simps]
	)

	lemma is_ntcfE':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<Z> \<alpha>"
	and "vfsequence \<NN>"
	and "vcard \<NN> = 5\<^sub>\<nat>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
	and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
	and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
	and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	using assms by (simp add: is_ntcfD')


	text\<open>Slicing.\<close>

	context is_ntcf
	begin

	interpretation ntsmcf:
	is_ntsmcf \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close> \<open>cf_smcf \<GG>\<close> \<open>ntcf_ntsmcf \<NN>\<close>
	by (rule ntcf_is_ntsmcf)

	lemmas_with [unfolded slicing_simps]:
	- ntcf_NTMap_vsv = ntsmcf.ntsmcf_NTMap_vsv
	+ ntcf_NTMap_vsv(not cat_cs_intros: clash) = ntsmcf.ntsmcf_NTMap_vsv
	and ntcf_NTMap_vdomain[cat_cs_simps] = ntsmcf.ntsmcf_NTMap_vdomain
	and ntcf_NTMap_is_arr = ntsmcf.ntsmcf_NTMap_is_arr
	and ntcf_NTMap_is_arr'[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_is_arr'

	sublocale NTMap: vsv \<open>\<NN>\<lparr>NTMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (rule ntcf_NTMap_vsv) (simp add: cat_cs_simps)

	lemmas_with [unfolded slicing_simps]:
	ntcf_NTMap_app_in_Arr[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_app_in_Arr
	and ntcf_NTMap_vrange_vifunion = ntsmcf.ntsmcf_NTMap_vrange_vifunion
	and ntcf_NTMap_vrange = ntsmcf.ntsmcf_NTMap_vrange
	and ntcf_NTMap_vsubset_Vset = ntsmcf.ntsmcf_NTMap_vsubset_Vset
	and ntcf_NTMap_in_Vset = ntsmcf.ntsmcf_NTMap_in_Vset
	and ntcf_is_ntsmcf_if_ge_Limit = ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit

	lemmas_with [unfolded slicing_simps]:
	ntcf_Comp_commute[cat_cs_intros] = ntsmcf.ntsmcf_Comp_commute
	and ntcf_Comp_commute' = ntsmcf.ntsmcf_Comp_commute'
	and ntcf_Comp_commute'' = ntsmcf.ntsmcf_Comp_commute''

	end

	lemmas [cat_cs_simps] = is_ntcf.ntcf_NTMap_vdomain

	lemmas [cat_cs_intros] =
	+ is_ntcf.ntcf_NTMap_vsv
	is_ntcf.ntcf_NTMap_is_arr'
	ntsmcf_hcomp_NTMap_vsv


	text\<open>Elementary properties.\<close>

	lemma ntcf_eqI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	and "\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>"
	and "\<FF> = \<FF>'"
	and "\<GG> = \<GG>'"
	and "\<AA> = \<AA>'"
	and "\<BB> = \<BB>'"
	shows "\<NN> = \<NN>'"
	proof-
	interpret L: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret R: is_ntcf \<alpha> \<AA>' \<BB>' \<FF>' \<GG>' \<NN>' by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<NN> = 5\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<NN> = \<D>\<^sub>\<circ> \<NN>'"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	from assms(4-7) have sup:
	"\<NN>\<lparr>NTDom\<rparr> = \<NN>'\<lparr>NTDom\<rparr>" "\<NN>\<lparr>NTCod\<rparr> = \<NN>'\<lparr>NTCod\<rparr>"
	"\<NN>\<lparr>NTDGDom\<rparr> = \<NN>'\<lparr>NTDGDom\<rparr>" "\<NN>\<lparr>NTDGCod\<rparr> = \<NN>'\<lparr>NTDGCod\<rparr>"
	by (simp_all add: cat_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<NN> \<Longrightarrow> \<NN>\<lparr>a\<rparr> = \<NN>'\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms(3) sup)
	(auto simp: nt_field_simps)
	qed auto
	qed

	lemma ntcf_ntsmcf_eqI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	and "\<FF> = \<FF>'"
	and "\<GG> = \<GG>'"
	and "\<AA> = \<AA>'"
	and "\<BB> = \<BB>'"
	and "ntcf_ntsmcf \<NN> = ntcf_ntsmcf \<NN>'"
	shows "\<NN> = \<NN>'"
	proof(rule ntcf_eqI[of \<alpha>])
	from assms(7) have "ntcf_ntsmcf \<NN>\<lparr>NTMap\<rparr> = ntcf_ntsmcf \<NN>'\<lparr>NTMap\<rparr>" by simp
	then show "\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>" unfolding slicing_simps by simp_all
	from assms(3-6) show "\<FF> = \<FF>'" "\<GG> = \<GG>'" "\<AA> = \<AA>'" "\<BB> = \<BB>'" by simp_all
	qed (auto simp: assms(1,2))

	lemma (in is_ntcf) ntcf_def:
	"\<NN> = [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<NN> = 5\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps V_cs_simps)
	have dom_rhs:
	"\<D>\<^sub>\<circ> [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>]\<^sub>\<circ> = 5\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show
	"\<D>\<^sub>\<circ> \<NN> = \<D>\<^sub>\<circ> [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<NN> \<Longrightarrow>
	\<NN>\<lparr>a\<rparr> = [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	by (unfold dom_lhs, elim_in_numeral, unfold nt_field_simps)
	(simp_all add: nat_omega_simps)
	qed (auto simp: vsv_axioms)

	lemma (in is_ntcf) ntcf_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<NN> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [cat_cs_intros] =
	ntcf_NTMap_in_Vset
	NTDom.cf_in_Vset
	NTCod.cf_in_Vset
	NTDom.HomDom.cat_in_Vset
	NTDom.HomCod.cat_in_Vset
	from assms(2) show ?thesis
	by (subst ntcf_def)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma (in is_ntcf) ntcf_is_ntcf_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
	proof(intro is_ntcfI)
	show "ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> cat_smc \<BB>"
	by (rule is_ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit[OF ntcf_is_ntsmcf assms])
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro:
	V_cs_intros
	assms
	NTDom.cf_is_functor_if_ge_Limit
	NTCod.cf_is_functor_if_ge_Limit
	)+

	lemma small_all_ntcfs[simp]:
	"small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_ntcf.ntcf_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma small_ntcfs[simp]: "small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto

	lemma small_these_ntcfs[simp]: "small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto


	text\<open>Further elementary results.\<close>

	lemma these_ntcfs_iff: (not simp)
	"\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto



	subsection\<open>Opposite natural transformation\<close>


	text\<open>See section 1.5 in \cite{bodo_categories_1970}.\<close>

	definition op_ntcf :: "V \<Rightarrow> V"
	where "op_ntcf \<NN> =
	[
	\<NN>\<lparr>NTMap\<rparr>,
	op_cf (\<NN>\<lparr>NTCod\<rparr>),
	op_cf (\<NN>\<lparr>NTDom\<rparr>),
	op_cat (\<NN>\<lparr>NTDGDom\<rparr>),
	op_cat (\<NN>\<lparr>NTDGCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_ntcf_components[cat_op_simps]:
	shows "op_ntcf \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	and "op_ntcf \<NN>\<lparr>NTDom\<rparr> = op_cf (\<NN>\<lparr>NTCod\<rparr>)"
	and "op_ntcf \<NN>\<lparr>NTCod\<rparr> = op_cf (\<NN>\<lparr>NTDom\<rparr>)"
	and "op_ntcf \<NN>\<lparr>NTDGDom\<rparr> = op_cat (\<NN>\<lparr>NTDGDom\<rparr>)"
	and "op_ntcf \<NN>\<lparr>NTDGCod\<rparr> = op_cat (\<NN>\<lparr>NTDGCod\<rparr>)"
	unfolding op_ntcf_def nt_field_simps by (auto simp: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma ntcf_ntsmcf_op_ntcf[slicing_commute]:
	"op_ntsmcf (ntcf_ntsmcf \<NN>) = ntcf_ntsmcf (op_ntcf \<NN>)"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) = 5\<^sub>\<nat>"
	unfolding op_ntsmcf_def by (auto simp: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_ntsmcf (op_ntcf \<NN>)) = 5\<^sub>\<nat>"
	unfolding ntcf_ntsmcf_def by (auto simp: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) = \<D>\<^sub>\<circ> (ntcf_ntsmcf (op_ntcf \<NN>))"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) \<Longrightarrow>
	op_ntsmcf (ntcf_ntsmcf \<NN>)\<lparr>a\<rparr> = ntcf_ntsmcf (op_ntcf \<NN>)\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold nt_field_simps ntcf_ntsmcf_def op_ntcf_def op_ntsmcf_def
	)
	(auto simp: nat_omega_simps slicing_commute[symmetric])
	qed (auto simp: ntcf_ntsmcf_def op_ntsmcf_def)


	text\<open>Elementary properties.\<close>

	lemma op_ntcf_vsv[cat_op_intros]: "vsv (op_ntcf \<FF>)"
	unfolding op_ntcf_def by auto


	subsubsection\<open>Further properties\<close>

	lemma (in is_ntcf) is_ntcf_op:
	"op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	proof(rule is_ntcfI, unfold cat_op_simps)
	show "vfsequence (op_ntcf \<NN>)" by (simp add: op_ntcf_def)
	show "vcard (op_ntcf \<NN>) = 5\<^sub>\<nat>" by (simp add: op_ntcf_def nat_omega_simps)
	qed
	(
	use is_ntcf_axioms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_cs_simps slicing_commute[symmetric]
	cs_intro: cat_cs_intros cat_op_intros smc_op_intros slicing_intros
	\<close>
	)+

	lemma (in is_ntcf) is_ntcf_op'[cat_op_intros]:
	assumes "\<GG>' = op_cf \<GG>"
	and "\<FF>' = op_cf \<FF>"
	and "\<AA>' = op_cat \<AA>"
	and "\<BB>' = op_cat \<BB>"
	shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_ntcf_op)

	lemmas [cat_op_intros] = is_ntcf.is_ntcf_op'

	lemma (in is_ntcf) ntcf_op_ntcf_op_ntcf[cat_op_simps]:
	"op_ntcf (op_ntcf \<NN>) = \<NN>"
	proof(rule ntcf_eqI[of \<alpha> \<AA> \<BB> \<FF> \<GG> _ \<AA> \<BB> \<FF> \<GG>], unfold cat_op_simps)
	interpret op:
	is_ntcf \<alpha> \<open>op_cat \<AA>\<close> \<open>op_cat \<BB>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> \<open>op_ntcf \<NN>\<close>
	by (rule is_ntcf_op)
	from op.is_ntcf_op show
	"op_ntcf (op_ntcf \<NN>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (simp add: cat_op_simps)
	qed (auto simp: cat_cs_intros)

	lemmas ntcf_op_ntcf_op_ntcf[cat_op_simps] =
	is_ntcf.ntcf_op_ntcf_op_ntcf

	lemma eq_op_ntcf_iff[cat_op_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	shows "op_ntcf \<NN> = op_ntcf \<NN>' \<longleftrightarrow> \<NN> = \<NN>'"
	proof
	interpret L: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret R: is_ntcf \<alpha> \<AA>' \<BB>' \<FF>' \<GG>' \<NN>' by (rule assms(2))
	assume prems: "op_ntcf \<NN> = op_ntcf \<NN>'"
	show "\<NN> = \<NN>'"
	proof(rule ntcf_eqI[OF assms])
	from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf show
	"\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>"
	by metis+
	from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf
	have "\<NN>\<lparr>NTDom\<rparr> = \<NN>'\<lparr>NTDom\<rparr>"
	and "\<NN>\<lparr>NTCod\<rparr> = \<NN>'\<lparr>NTCod\<rparr>"
	and "\<NN>\<lparr>NTDGDom\<rparr> = \<NN>'\<lparr>NTDGDom\<rparr>"
	and "\<NN>\<lparr>NTDGCod\<rparr> = \<NN>'\<lparr>NTDGCod\<rparr>"
	by metis+
	then show "\<FF> = \<FF>'" "\<GG> = \<GG>'" "\<AA> = \<AA>'" "\<BB> = \<BB>'"
	by (auto simp: cat_cs_simps)
	qed
	qed auto



	subsection\<open>Vertical composition of natural transformations\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) ntcf_vcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close> 55)
	where "ntcf_vcomp \<equiv> ntsmcf_vcomp"

	lemmas [cat_cs_simps] = ntsmcf_vcomp_components(2-5)


	text\<open>Slicing.\<close>

	lemma ntcf_ntsmcf_ntcf_vcomp[slicing_commute]:
	"ntcf_ntsmcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	unfolding
	ntsmcf_vcomp_def ntcf_ntsmcf_def cat_smc_def nt_field_simps dg_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	lemma ntcf_vcomp_NTMap_vdomain[cat_cs_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by auto
	show ?thesis
	by
	(
	rule ntsmcf_vcomp_NTMap_vdomain
	[
	OF \<NN>.ntcf_is_ntsmcf,
	of \<open>ntcf_ntsmcf \<MM>\<close>,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma ntcf_vcomp_NTMap_app[cat_cs_simps]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms by clarsimp
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by clarsimp
	show ?thesis
	by
	(
	rule ntsmcf_vcomp_NTMap_app
	[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed

	lemma ntcf_vcomp_NTMap_vrange:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms by auto
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by auto
	show ?thesis
	by
	(
	rule
	ntsmcf_vcomp_NTMap_vrange[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma ntcf_vcomp_composable_commute[cat_cs_simps]:
	\<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and [intro]: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	shows
	"(\<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<HH>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	by
	(
	rule ntsmcf_vcomp_composable_commute[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps,
	OF assms(3)
	]
	)
	qed

	lemma ntcf_vcomp_is_ntcf[cat_cs_intros]:
	\<comment>\<open>see Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	proof(intro is_ntcfI)
	show "vfsequence (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" by (simp add: ntsmcf_vcomp_def)
	show "vcard (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
	unfolding ntsmcf_vcomp_def by (simp add: nat_omega_simps)
	show "ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<HH> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	by
	(
	rule ntsmcf_vcomp_is_ntsmcf[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	)
	qed (auto simp: ntsmcf_vcomp_components(1) cat_cs_simps cat_cs_intros)
	qed

	lemma ntcf_vcomp_assoc[cat_cs_simps]:
	\<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<LL> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof-
	interpret \<LL>: is_ntcf \<alpha> \<AA> \<BB> \<HH> \<KK> \<LL> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
	+ find_theorems "vsv (\<LL>\<lparr>NTMap\<rparr>) "
	+
	+ thm vsvI
	show ?thesis
	proof(rule ntcf_eqI[of \<alpha>])
	from ntsmcf_vcomp_assoc[
	OF \<LL>.ntcf_is_ntsmcf \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	have
	"ntcf_ntsmcf (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> =
	ntcf_ntsmcf (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	by simp
	then show "(\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	unfolding slicing_simps .
	qed (auto intro: cat_cs_intros)
	qed


	subsubsection\<open>
	The opposite of the vertical composition of natural transformations
	\<close>

	lemma op_ntcf_ntcf_vcomp[cat_op_simps]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms(1) by auto
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms(2) by auto
	show ?thesis
	proof(rule sym, rule ntcf_eqI[of \<alpha>])
	from
	op_ntsmcf_ntsmcf_vcomp
	[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	have "ntcf_ntsmcf (op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>)\<lparr>NTMap\<rparr> =
	ntcf_ntsmcf (op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	by simp
	then show "(op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>)\<lparr>NTMap\<rparr> = op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>"
	unfolding slicing_simps .
	qed (auto intro: cat_cs_intros cat_op_intros)
	qed



	subsection\<open>Horizontal composition of natural transformations\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) ntcf_hcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close> 55)
	where "ntcf_hcomp \<equiv> ntsmcf_hcomp"

	lemmas [cat_cs_simps] = ntsmcf_hcomp_components(2-5)


	text\<open>Slicing.\<close>

	lemma ntcf_ntsmcf_ntcf_hcomp[slicing_commute]:
	"ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof(rule vsv_eqI)
	show "vsv (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)"
	unfolding ntsmcf_hcomp_def by auto
	show "vsv (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))" unfolding ntcf_ntsmcf_def by auto
	have dom_lhs:
	"\<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>) = 5\<^sub>\<nat>"
	unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) = 5\<^sub>\<nat>"
	unfolding ntcf_ntsmcf_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>) =
	\<D>\<^sub>\<circ> (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))"
	unfolding dom_lhs dom_rhs ..
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)"
	then show
	"(ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)\<lparr>a\<rparr> = ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>a\<rparr>"
	unfolding dom_lhs
	by (elim_in_numeral; fold nt_field_simps)
	(simp_all add: ntsmcf_hcomp_components slicing_simps slicing_commute)
	qed


	subsubsection\<open>Natural transformation map\<close>

	lemma ntcf_hcomp_NTMap_vdomain[cat_cs_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	show ?thesis unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
	qed

	lemma ntcf_hcomp_NTMap_app[cat_cs_simps]:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	\<GG>'\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	from assms(3) show ?thesis
	unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
	qed

	lemma ntcf_hcomp_NTMap_vrange:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	by
	(
	rule ntsmcf_hcomp_NTMap_vrange[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma ntcf_hcomp_composable_commute:
	\<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	shows
	"(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	(is \<open>?\<MM>\<NN>b \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>'\<FF>f = ?\<GG>'\<GG>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<MM>\<NN>a\<close>)
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	by
	(
	rule ntsmcf_hcomp_composable_commute[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute,
	OF assms(3)
	]
	)
	qed

	lemma ntcf_hcomp_is_ntcf:
	\<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	proof(intro is_ntcfI)
	show "vfsequence (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
	show "vcard (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
	unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
	show "ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	cf_smcf (\<FF>' \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>) :
	cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	rule ntsmcf_hcomp_is_ntsmcf[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	)
	qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps intro: cat_cs_intros)
	qed

	lemma ntcf_hcomp_is_ntcf'[cat_cs_intros]:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> = \<FF>' \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<SS>' = \<GG>' \<circ>\<^sub>C\<^sub>F \<GG>"
	shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_ntcf)

	lemma ntcf_hcomp_associativ[cat_cs_simps]:
	assumes "\<LL> : \<FF>'' \<mapsto>\<^sub>C\<^sub>F \<GG>'' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof-
	interpret \<LL>: is_ntcf \<alpha> \<CC> \<DD> \<FF>'' \<GG>'' \<LL> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
	show ?thesis
	proof(rule ntcf_eqI[of \<alpha>])
	show "\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	\<FF>'' \<circ>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>'' \<circ>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from ntsmcf_hcomp_assoc[
	OF \<LL>.ntcf_is_ntsmcf \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_commute
	]
	have
	"ntcf_ntsmcf (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> =
	ntcf_ntsmcf (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	by simp
	then show "(\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	unfolding slicing_simps .
	qed (auto intro: cat_cs_intros)
	qed


	subsubsection\<open>
	The opposite of the horizontal composition of natural transformations
	\<close>

	lemma op_ntcf_ntcf_hcomp[cat_op_simps]:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	proof(rule sym, rule ntcf_eqI[of \<alpha>])
	from op_ntsmcf_ntsmcf_hcomp[
	OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
	unfolded slicing_simps slicing_commute
	]
	have "ntcf_ntsmcf (op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>)\<lparr>NTMap\<rparr> =
	ntcf_ntsmcf (op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	by simp
	then show "(op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>)\<lparr>NTMap\<rparr> = op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>"
	unfolding slicing_simps .
	have "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule ntcf_hcomp_is_ntcf[OF assms])
	from is_ntcf.is_ntcf_op[OF this] show
	"op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	op_cf \<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF>' \<circ>\<^sub>C\<^sub>F op_cf \<FF> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	unfolding cat_op_simps .
	qed (auto intro: cat_op_intros cat_cs_intros)
	qed



	subsection\<open>Interchange law\<close>

	lemma ntcf_comp_interchange_law:
	\<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "((\<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>') \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) = (\<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof-
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	interpret \<MM>': is_ntcf \<alpha> \<BB> \<CC> \<GG>' \<HH>' \<MM>' by (rule assms(3))
	interpret \<NN>': is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<NN>' by (rule assms(4))
	show ?thesis
	proof(rule ntcf_eqI)
	from ntsmcf_comp_interchange_law
	[
	OF
	\<MM>.ntcf_is_ntsmcf
	\<NN>.ntcf_is_ntsmcf
	\<MM>'.ntcf_is_ntsmcf
	\<NN>'.ntcf_is_ntsmcf
	]
	have
	"(
	(ntcf_ntsmcf \<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>') \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F
	(ntcf_ntsmcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)
	)\<lparr>NTMap\<rparr> =
	(
	(ntcf_ntsmcf \<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(ntcf_ntsmcf \<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)
	)\<lparr>NTMap\<rparr>"
	by simp
	then show
	"(\<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr> =
	(\<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
	unfolding slicing_simps slicing_commute .
	qed (auto intro: cat_cs_intros)
	qed



	subsection\<open>Identity natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>

	definition ntcf_id :: "V \<Rightarrow> V"
	where "ntcf_id \<FF> = [\<FF>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>, \<FF>, \<FF>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_id_components:
	shows "ntcf_id \<FF>\<lparr>NTMap\<rparr> = \<FF>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDom\<rparr> = \<FF>"
	and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTCod\<rparr> = \<FF>"
	and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDGDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDGCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding ntcf_id_def nt_field_simps by (simp_all add: nat_omega_simps)

	lemma (in is_functor) is_functor_ntcf_id_components:
	shows "ntcf_id \<FF>\<lparr>NTMap\<rparr> = \<BB>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and "ntcf_id \<FF>\<lparr>NTDom\<rparr> = \<FF>"
	and "ntcf_id \<FF>\<lparr>NTCod\<rparr> = \<FF>"
	and "ntcf_id \<FF>\<lparr>NTDGDom\<rparr> = \<AA>"
	and "ntcf_id \<FF>\<lparr>NTDGCod\<rparr> = \<BB>"
	unfolding ntcf_id_components by (simp_all add: cat_cs_simps)


	subsubsection\<open>Natural transformation map\<close>

	lemma (in is_functor) ntcf_id_NTMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	using cf_ObjMap_vrange unfolding is_functor_ntcf_id_components
	by (auto simp: cat_cs_simps)

	lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_vdomain

	lemma (in is_functor) ntcf_id_NTMap_app_vdomain[cat_cs_simps]:
	assumes [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	unfolding is_functor_ntcf_id_components
	by (rule vsv_vcomp_at) (auto simp: cf_ObjMap_vrange cat_cs_simps cat_cs_intros)

	lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_app_vdomain

	lemma (in is_functor) ntcf_id_NTMap_vsv[cat_cs_intros]:
	"vsv (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
	unfolding is_functor_ntcf_id_components by (auto intro: vsv_vcomp)

	lemmas [cat_cs_intros] = is_functor.ntcf_id_NTMap_vsv

	lemma (in is_functor) ntcf_id_NTMap_vrange:
	"\<R>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	proof(rule vsubsetI)
	interpret vsv \<open>ntcf_id \<FF>\<lparr>NTMap\<rparr>\<close> by (rule ntcf_id_NTMap_vsv)
	fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
	then obtain a
	where f_def: "f = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
	using vrange_atD by metis
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by (auto simp: cat_cs_simps)
	then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (auto dest: cf_ObjMap_app_in_HomCod_Obj HomCod.cat_CId_is_arr)
	qed


	subsubsection\<open>Further properties\<close>

	lemma (in is_functor) cf_ntcf_id_is_ntcf[cat_cs_intros]:
	"ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(rule is_ntcfI, unfold is_functor_ntcf_id_components(2,3,4,5))
	show "ntcf_ntsmcf (ntcf_id \<FF>) :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	proof
	(
	rule is_ntsmcfI,
	unfold slicing_simps slicing_commute is_functor_ntcf_id_components(2,3,4,5)
	)
	show "ntsmcf_tdghm (ntcf_ntsmcf (ntcf_id \<FF>)) :
	smcf_dghm (cf_smcf \<FF>) \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm (cf_smcf \<FF>) :
	smc_dg (cat_smc \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg (cat_smc \<BB>)"
	by
	(
	rule is_tdghmI,
	unfold
	slicing_simps
	slicing_commute
	is_functor_ntcf_id_components(2,3,4,5)
	)
	(
	auto
	simp:
	cat_cs_simps
	cat_cs_intros
	nat_omega_simps
	ntsmcf_tdghm_def
	cf_is_semifunctor
	intro: slicing_intros
	)
	fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	with is_functor_axioms show
	"ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: ntcf_ntsmcf_def nat_omega_simps intro: slicing_intros)
	qed (auto simp: ntcf_id_def nat_omega_simps intro: cat_cs_intros)

	lemma (in is_functor) cf_ntcf_id_is_ntcf':
	assumes "\<GG>' = \<FF>" and "\<HH>' = \<FF>"
	shows "ntcf_id \<FF> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule cf_ntcf_id_is_ntcf)

	lemmas [cat_cs_intros] = is_functor.cf_ntcf_id_is_ntcf'

	lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_left_left[cat_cs_simps]:
	\<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
	"ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
	proof(rule ntcf_eqI[of \<alpha>])
	interpret id: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<GG> \<open>ntcf_id \<GG>\<close>
	by (rule NTCod.cf_ntcf_id_is_ntcf)
	show "(ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	show [simp]: "\<D>\<^sub>\<circ> ((ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	unfolding ntsmcf_vcomp_components
	by (simp add: cat_cs_simps)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
	then show "(ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: ntsmcf_vcomp_components)
	qed (auto intro: cat_cs_intros)

	lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_left_left

	lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_right_left[cat_cs_simps]:
	\<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
	"\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = \<NN>"
	proof(rule ntcf_eqI[of \<alpha>])
	interpret id: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<FF> \<open>ntcf_id \<FF>\<close>
	by (rule NTDom.cf_ntcf_id_is_ntcf)
	show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	show [simp]: "\<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>)"
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
	then show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: ntsmcf_vcomp_components)
	qed (auto intro: cat_cs_intros)

	lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_right_left

	lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_left_left[cat_cs_simps]:
	\<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
	"ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
	proof(rule ntcf_eqI)
	interpret id: is_ntcf \<alpha> \<BB> \<BB> \<open>cf_id \<BB>\<close> \<open>cf_id \<BB>\<close> \<open>ntcf_id (cf_id \<BB>)\<close>
	by
	(
	simp add:
	NTDom.HomCod.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
	)
	show "ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> :
	cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "(ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"
	then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding ntcf_hcomp_NTMap_vdomain[OF is_ntcf_axioms] by simp
	with is_ntcf_axioms show
	"(ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
	qed (auto simp: cat_cs_simps intro: cat_cs_intros)

	lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_left_left

	lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_right_left[cat_cs_simps]:
	\<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
	"\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>) = \<NN>"
	proof(rule ntcf_eqI[of \<alpha>])
	interpret id: is_ntcf \<alpha> \<AA> \<AA> \<open>cf_id \<AA>\<close> \<open>cf_id \<AA>\<close> \<open>ntcf_id (cf_id \<AA>)\<close>
	by
	(
	simp add:
	NTDom.HomDom.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
	)
	show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>) :
	\<FF> \<circ>\<^sub>C\<^sub>F cf_id \<AA> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F cf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr>)"
	then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding ntcf_hcomp_NTMap_vdomain[OF id.is_ntcf_axioms] by simp
	with is_ntcf_axioms show
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
	qed (auto simp: cat_cs_simps cat_cs_intros)

	lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_right_left


	subsubsection\<open>The opposite identity natural transformation\<close>

	lemma (in is_functor) cf_ntcf_id_op_cf: "ntcf_id (op_cf \<FF>) = op_ntcf (ntcf_id \<FF>)"
	proof(rule ntcf_eqI)
	show ntcfid_op:
	"ntcf_id (op_cf \<FF>) : op_cf \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (simp add: is_functor.cf_ntcf_id_is_ntcf local.is_functor_op)
	show "ntcf_id (op_cf \<FF>)\<lparr>NTMap\<rparr> = op_ntcf (ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
	by (rule vsv_eqI, unfold cat_op_simps)
	(
	auto
	simp: cat_op_simps cat_cs_simps ntcf_id_components(1)
	intro: vsv_vcomp
	)
	qed (auto intro: cat_op_intros cat_cs_intros)


	subsubsection\<open>Identity natural transformation of a composition of functors\<close>

	lemma ntcf_id_cf_comp:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
	proof(rule ntcf_eqI)
	from assms show \<GG>\<FF>: "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	interpret \<GG>\<FF>: is_ntcf \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<close>
	by (rule \<GG>\<FF>)
	from assms show \<GG>_\<FF>:
	"ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	interpret \<GG>_\<FF>: is_ntcf \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>\<close>
	by (rule \<GG>_\<FF>)
	show "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold \<GG>\<FF>.ntcf_NTMap_vdomain \<GG>_\<FF>.ntcf_NTMap_vdomain)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show
	"ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed auto
	qed auto

	lemmas [cat_cs_simps] = ntcf_id_cf_comp[symmetric]



	subsection\<open>Composition of a natural transformation and a functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	abbreviation (input) ntcf_cf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F" 55)
	where "ntcf_cf_comp \<equiv> tdghm_dghm_comp"


	text\<open>Slicing.\<close>

	lemma ntsmcf_tdghm_ntsmcf_smcf_comp[slicing_commute]:
	"ntcf_ntsmcf \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<HH> = ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)"
	unfolding
	ntcf_ntsmcf_def
	cf_smcf_def
	cat_smc_def
	tdghm_dghm_comp_def
	dghm_comp_def
	ntsmcf_tdghm_def
	smcf_dghm_def
	smc_dg_def
	dg_field_simps
	dghm_field_simps
	nt_field_simps
	by (simp add: nat_omega_simps) (slow)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda (in is_functor)
	tdghm_dghm_comp_components(1)[where \<HH>=\<FF>, unfolded cf_HomDom]
	\|vdomain ntcf_cf_comp_NTMap_vdomain[cat_cs_simps]\|
	\|app ntcf_cf_comp_NTMap_app[cat_cs_simps]\|

	lemmas [cat_cs_simps] =
	is_functor.ntcf_cf_comp_NTMap_vdomain
	is_functor.ntcf_cf_comp_NTMap_app

	lemma ntcf_cf_comp_NTMap_vrange:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
	show ?thesis unfolding tdghm_dghm_comp_components
	by (auto simp: cat_cs_simps intro: cat_cs_intros)
	qed


	subsubsection\<open>
	Opposite of the composition of a natural transformation and a functor
	\<close>

	lemma op_ntcf_ntcf_cf_comp[cat_op_simps]:
	"op_ntcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) = op_ntcf \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<HH>"
	unfolding
	tdghm_dghm_comp_def
	dghm_comp_def
	op_ntcf_def
	op_cf_def
	op_cat_def
	dg_field_simps
	dghm_field_simps
	nt_field_simps
	by (simp add: nat_omega_simps) (slow)


	subsubsection\<open>
	Composition of a natural transformation and a
	functor is a natural transformation
	\<close>

	lemma ntcf_cf_comp_is_ntcf:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
	show ?thesis
	proof(rule is_ntcfI)
	show "vfsequence (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)"
	unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
	from assms show "\<FF> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	from assms show "\<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	show "vcard (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) = 5\<^sub>\<nat>"
	unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
	from assms show
	"ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) :
	cf_smcf (\<FF> \<circ>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<HH>) :
	cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: slicing_intros smc_cs_intros cat_cs_intros
	)
	qed (auto simp: tdghm_dghm_comp_components(1) cat_cs_simps)
	qed

	lemma ntcf_cf_comp_is_ntcf'[cat_cs_intros]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = \<FF> \<circ>\<^sub>C\<^sub>F \<HH>"
	and "\<GG>' = \<GG> \<circ>\<^sub>C\<^sub>F \<HH>"
	shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (simp add: ntcf_cf_comp_is_ntcf)


	subsubsection\<open>Further properties\<close>

	lemma ntcf_cf_comp_ntcf_cf_comp_assoc:
	assumes "\<NN> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> = \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<CC> \<DD> \<HH> \<HH>' \<NN> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3))
	show ?thesis
	proof(rule ntcf_ntsmcf_eqI)
	from assms show
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> :
	\<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH>' \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) :
	\<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH>' \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms show
	"ntcf_ntsmcf ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) =
	ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>))"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: slicing_intros ntsmcf_smcf_comp_ntsmcf_smcf_comp_assoc
	)
	qed simp_all
	qed

	lemma (in is_ntcf) ntcf_ntcf_cf_comp_cf_id[cat_cs_simps]:
	"\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA> = \<NN>"
	proof(rule ntcf_ntsmcf_eqI)
	show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA>) = ntcf_ntsmcf \<NN>"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: cat_cs_intros slicing_intros smc_cs_simps
	)
	qed simp_all

	lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_cf_comp_cf_id

	lemma ntcf_vcomp_ntcf_cf_comp[cat_cs_simps]:
	assumes "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) = (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>"
	proof(rule ntcf_ntsmcf_eqI)
	from assms show
	"\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) :
	\<FF> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show
	"ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)) =
	ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	unfolding slicing_commute[symmetric]
	by (intro ntsmcf_vcomp_ntsmcf_smcf_comp)
	(cs_concl cs_intro: slicing_intros)
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+



	subsection\<open>Composition of a functor and a natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	abbreviation (input) cf_ntcf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F" 55)
	where "cf_ntcf_comp \<equiv> dghm_tdghm_comp"


	text\<open>Slicing.\<close>

	lemma ntcf_ntsmcf_cf_ntcf_comp[slicing_commute]:
	"cf_smcf \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	unfolding
	ntcf_ntsmcf_def
	cf_smcf_def
	cat_smc_def
	dghm_tdghm_comp_def
	dghm_comp_def
	ntsmcf_tdghm_def
	smcf_dghm_def
	smc_dg_def
	dg_field_simps
	dghm_field_simps
	nt_field_simps
	by (simp add: nat_omega_simps) (slow)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda (in is_ntcf)
	dghm_tdghm_comp_components(1)[where \<NN>=\<NN>, unfolded ntcf_NTDGDom]
	\|vdomain cf_ntcf_comp_NTMap_vdomain\|
	\|app cf_ntcf_comp_NTMap_app\|

	lemmas [cat_cs_simps] =
	is_ntcf.cf_ntcf_comp_NTMap_vdomain
	is_ntcf.cf_ntcf_comp_NTMap_app

	lemma cf_ntcf_comp_NTMap_vrange:
	assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	unfolding dghm_tdghm_comp_components
	by (auto simp: cat_cs_simps intro: cat_cs_intros)
	qed


	subsubsection\<open>
	Opposite of the composition of a functor and a natural transformation
	\<close>

	lemma op_ntcf_cf_ntcf_comp[cat_op_simps]:
	"op_ntcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>"
	unfolding
	dghm_tdghm_comp_def
	dghm_comp_def
	op_ntcf_def
	op_cf_def
	op_cat_def
	dg_field_simps
	dghm_field_simps
	nt_field_simps
	by (simp add: nat_omega_simps) (slow)


	subsubsection\<open>
	Composition of a functor and a natural transformation
	is a natural transformation
	\<close>

	lemma cf_ntcf_comp_is_ntcf:
	assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<HH> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	proof(rule is_ntcfI)
	show "vfsequence (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" unfolding dghm_tdghm_comp_def by simp
	from assms show "\<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	from assms show "\<HH> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros)
	show "vcard (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
	unfolding dghm_tdghm_comp_def by (simp add: nat_omega_simps)
	from assms show "ntcf_ntsmcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	cf_smcf (\<HH> \<circ>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) :
	cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: slicing_intros smc_cs_intros
	)
	qed (auto simp: dghm_tdghm_comp_components(1) cat_cs_simps)
	qed

	lemma cf_ntcf_comp_is_functor'[cat_cs_intros]:
	assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = \<HH> \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<GG>' = \<HH> \<circ>\<^sub>C\<^sub>F \<GG>"
	shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (simp add: cf_ntcf_comp_is_ntcf)


	subsubsection\<open>Further properties\<close>

	lemma cf_comp_cf_ntcf_comp_assoc:
	assumes "\<NN> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof(rule ntcf_ntsmcf_eqI)
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<HH> \<HH>' \<NN> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))
	interpret \<GG>: is_functor \<alpha> \<CC> \<DD> \<GG> by (rule assms(3))
	from assms show "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> :
	\<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_intro: cat_cs_intros)
	from assms show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
	\<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms show
	"ntcf_ntsmcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
	ntcf_ntsmcf (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))"
	by
	(
	cs_concl
	cs_simp: slicing_commute[symmetric]
	cs_intro: slicing_intros smcf_comp_smcf_ntsmcf_comp_assoc
	)
	qed simp_all

	lemma (in is_ntcf) ntcf_cf_ntcf_comp_cf_id[cat_cs_simps]:
	"cf_id \<BB> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
	proof(rule ntcf_ntsmcf_eqI)
	show "cf_id \<BB> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_ntsmcf (smcf_id \<BB> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN>) = ntcf_ntsmcf \<NN>"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: cat_cs_intros slicing_intros smc_cs_simps
	)
	qed simp_all

	lemmas [cat_cs_simps] = is_ntcf.ntcf_cf_ntcf_comp_cf_id

	lemma cf_ntcf_comp_ntcf_cf_comp_assoc:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> = \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_functor \<alpha> \<CC> \<DD> \<HH> by (rule assms(2))
	interpret \<KK>: is_functor \<alpha> \<AA> \<BB> \<KK> by (rule assms(3))
	show ?thesis
	by (rule ntcf_ntsmcf_eqI)
	(
	use assms in
	\<open>
	cs_concl
	cs_simp: cat_cs_simps slicing_commute[symmetric]
	cs_intro:
	cat_cs_intros
	slicing_intros
	smcf_ntsmcf_comp_ntsmcf_smcf_comp_assoc
	\<close>
	)+
	qed

	lemma ntcf_cf_comp_ntcf_id[cat_cs_simps]:
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> = ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>"
	proof(rule ntcf_eqI)
	from assms have dom_lhs: "\<D>\<^sub>\<circ> ((ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms have dom_rhs: "\<D>\<^sub>\<circ> ((ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show
	"(ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto intro: cat_cs_intros)
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+

	-lemma cf_comp_cf_const_right[cat_cs_simps]:
	- assumes "category \<alpha> \<AA>"
	- and "category \<alpha> \<BB>"
	- and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<aa> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- shows "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
	-proof(rule cf_eqI)
	-
	- interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	- interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	- interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(3))
	-
	- from assms(4) show "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_intro: cat_cs_intros)
	- from assms(4) show "cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from assms(4) have ObjMap_dom_lhs:
	- "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from assms(4) have ObjMap_dom_rhs:
	- "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>"
	- proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	- fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	- with assms(4) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
	- cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed (auto intro: assms(4) cat_cs_intros)
	- from assms(4) have ArrMap_dom_lhs:
	- "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from assms(4) have ArrMap_dom_rhs:
	- "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show
	- "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>"
	- proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	- fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	- with assms(4) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> =
	- cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed (auto intro: assms(4) cat_cs_intros)
	-
	-qed simp_all
	-
	lemma cf_ntcf_comp_ntcf_vcomp:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
	show "\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = \<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	by (rule ntcf_ntsmcf_eqI)
	(
	use assms in
	\<open>
	cs_concl
	cs_simp: smc_cs_simps slicing_commute[symmetric]
	cs_intro:
	cat_cs_intros
	slicing_intros
	smcf_ntsmcf_comp_ntsmcf_vcomp
	\<close>
	)+
	qed



	subsection\<open>Constant natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III in \cite{mac_lane_categories_2010}.\<close>

	definition ntcf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_const \<JJ> \<CC> f =
	[
	vconst_on (\<JJ>\<lparr>Obj\<rparr>) f,
	cf_const \<JJ> \<CC> (\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>),
	cf_const \<JJ> \<CC> (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>),
	\<JJ>,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_const_components:
	shows "ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr> = vconst_on (\<JJ>\<lparr>Obj\<rparr>) f"
	and "ntcf_const \<JJ> \<CC> f\<lparr>NTDom\<rparr> = cf_const \<JJ> \<CC> (\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>)"
	and "ntcf_const \<JJ> \<CC> f\<lparr>NTCod\<rparr> = cf_const \<JJ> \<CC> (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>)"
	and "ntcf_const \<JJ> \<CC> f\<lparr>NTDGDom\<rparr> = \<JJ>"
	and "ntcf_const \<JJ> \<CC> f\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding ntcf_const_def nt_field_simps by (auto simp: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda ntcf_const_components(1)[folded VLambda_vconst_on]
	\|vsv ntcf_const_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain ntcf_const_ObjMap_vdomain[cat_cs_simps]\|
	\|app ntcf_const_ObjMap_app[cat_cs_simps]\|

	lemma ntcf_const_NTMap_ne_vrange:
	assumes "\<JJ>\<lparr>Obj\<rparr> \<noteq> 0"
	shows "\<R>\<^sub>\<circ> (ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>) = set {f}"
	using assms unfolding ntcf_const_components by simp

	lemma ntcf_const_NTMap_vempty_vrange:
	assumes "\<JJ>\<lparr>Obj\<rparr> = 0"
	shows "\<R>\<^sub>\<circ> (ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>) = 0"
	using assms unfolding ntcf_const_components by simp


	subsubsection\<open>Constant natural transformation is a natural transformation\<close>

	lemma ntcf_const_is_ntcf:
	assumes "category \<alpha> \<JJ>" and "category \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "ntcf_const \<JJ> \<CC> f : cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	show ?thesis
	proof(intro is_ntcfI')
	show "vfsequence (ntcf_const \<JJ> \<CC> f)" unfolding ntcf_const_def by auto
	show "cf_const \<JJ> \<CC> a : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule cf_const_is_functor)
	from assms(3) show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (simp add: cat_cs_intros)
	qed (auto simp: cat_cs_intros)
	from assms(3) show const_b_is_functor:
	"cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: cf_const_is_functor cat_cs_intros)
	show "vcard (ntcf_const \<JJ> \<CC> f) = 5\<^sub>\<nat>"
	unfolding ntcf_const_def by (simp add: nat_omega_simps)
	show
	"ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a'\<rparr> :
	cf_const \<JJ> \<CC> a\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> b\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	if "a' \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a'
	by (simp add: that assms(3) ntcf_const_components(1) dghm_const_ObjMap_app)
	from assms(3) show
	"ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
	cf_const \<JJ> \<CC> b \<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
	if "f' : a' \<mapsto>\<^bsub>\<JJ>\<^esub> b'" for f' a' b'
	using that dghm_const_ArrMap_app
	by (auto simp: ntcf_const_components cat_cs_intros cat_cs_simps)
	qed (use assms(3) in \<open>auto simp: ntcf_const_components\<close>)
	qed

	lemma ntcf_const_is_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<JJ>"
	and "category \<alpha> \<CC>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<AA> = cf_const \<JJ> \<CC> a"
	and "\<BB> = cf_const \<JJ> \<CC> b"
	and "\<JJ>' = \<JJ>"
	and "\<CC>' = \<CC>"
	shows "ntcf_const \<JJ> \<CC> f : \<AA> \<mapsto>\<^sub>C\<^sub>F \<BB> : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_ntcf)


	subsubsection\<open>Opposite constant natural transformation\<close>

	lemma op_ntcf_ntcf_const[cat_op_simps]:
	"op_ntcf (ntcf_const \<JJ> \<CC> f) = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	unfolding
	nt_field_simps dghm_field_simps dg_field_simps
	dghm_const_def ntcf_const_def op_cat_def op_cf_def op_ntcf_def
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Further properties\<close>

	lemma ntcf_const_ntcf_vcomp[cat_cs_simps]:
	assumes "category \<alpha> \<JJ>"
	and "category \<alpha> \<CC>"
	and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f = ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	proof-
	interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	from assms(3,4) have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c" by (simp add: cat_cs_intros)
	note \<JJ>\<CC>g = ntcf_const_is_ntcf[OF assms(1,2,3)]
	and \<JJ>\<CC>f = ntcf_const_is_ntcf[OF assms(1,2,4)]
	show ?thesis
	proof(rule ntcf_eqI)
	from ntcf_const_is_ntcf[OF assms(1,2,3)] ntcf_const_is_ntcf[OF assms(1,2,4)]
	show
	"ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f :
	cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule ntcf_vcomp_is_ntcf)
	show
	"ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) :
	cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule ntcf_const_is_ntcf[OF assms(1,2) gf])
	show "(ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)\<lparr>NTMap\<rparr> =
	ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>NTMap\<rparr>"
	unfolding ntcf_const_components
	proof(rule vsv_eqI, unfold ntcf_vcomp_NTMap_vdomain[OF \<JJ>\<CC>f])
	fix a assume prems: "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	then show
	"(ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	vconst_on (\<JJ>\<lparr>Obj\<rparr>) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>a\<rparr>"
	unfolding ntcf_vcomp_NTMap_app[OF \<JJ>\<CC>g \<JJ>\<CC>f prems]
	by (simp add: ntcf_const_components)
	qed (simp_all add: ntsmcf_vcomp_components)
	qed auto
	qed

	lemma ntcf_id_cf_const[cat_cs_simps]:
	assumes "category \<alpha> \<JJ>" and "category \<alpha> \<CC>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_id (cf_const \<JJ> \<CC> c) = ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)"
	proof(rule ntcf_eqI)
	interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	from assms show "ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) :
	cf_const \<JJ> \<CC> c \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: ntcf_const_is_ntcf)
	interpret const_c: is_functor \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close>
	by (rule cf_const_is_functor) (auto simp: assms(3) cat_cs_intros)
	show "ntcf_id (cf_const \<JJ> \<CC> c) :
	cf_const \<JJ> \<CC> c \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule const_c.cf_ntcf_id_is_ntcf)
	show "ntcf_id (cf_const \<JJ> \<CC> c)\<lparr>NTMap\<rparr> = ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold ntcf_const_components)
	show "vsv (ntcf_id (cf_const \<JJ> \<CC> c)\<lparr>NTMap\<rparr>)"
	unfolding ntcf_id_components by (auto simp: cat_cs_simps intro: vsv_vcomp)
	qed (auto simp: cat_cs_simps)
	qed simp_all

	lemma ntcf_cf_comp_cf_const_right[cat_cs_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "category \<alpha> \<AA>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b = ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(2))
	show ?thesis
	proof(rule ntcf_eqI)
	from assms(3) show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b :
	cf_const \<AA> \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) :
	\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) show "ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) :
	cf_const \<AA> \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) :
	\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) have dom_lhs:
	"\<D>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) have dom_rhs:
	"\<D>\<^sub>\<circ> (ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr> = ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms(3) show
	"(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto intro: cat_cs_intros)
	qed simp_all
	qed

	lemma cf_ntcf_comp_ntcf_id[cat_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
	proof-
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule ntcf_eqI)
	show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have dom_lhs: "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have dom_rhs: "\<D>\<^sub>\<circ> ((ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	then show
	"(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	(ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ qed (cs_concl cs_intro: cat_cs_intros)
	qed simp_all
	qed

	lemma (in is_functor) cf_ntcf_cf_comp_ntcf_const[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> = ntcf_const \<AA> \<CC> f"
	proof(rule ntcf_eqI)
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	from assms(2) show "ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> :
	cf_const \<AA> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	then have dom_lhs: "\<D>\<^sub>\<circ> ((ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms(2) show
	"ntcf_const \<AA> \<CC> f : cf_const \<AA> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "(ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr> = ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	then show
	"(ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed simp_all

	lemmas [cat_cs_simps] = is_functor.cf_ntcf_cf_comp_ntcf_const

	+lemma (in is_functor) cf_ntcf_comp_cf_ntcf_const[cat_cs_simps]:
	+ assumes "category \<alpha> \<JJ>"
	+ and "f : r' \<mapsto>\<^bsub>\<AA>\<^esub> r"
	+ shows "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f = ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	+proof(rule ntcf_eqI)
	+ interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
	+ from assms(2) have r': "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
	+ from assms(2) show "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f :
	+ cf_const \<JJ> \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) :
	+ \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ with assms(2) have dom_lhs:
	+ "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f)\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ from assms(2) show "ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) :
	+ cf_const \<JJ> \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) :
	+ \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ with assms(2) have dom_rhs:
	+ "\<D>\<^sub>\<circ> (ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ show
	+ "(\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f)\<lparr>NTMap\<rparr> =
	+ ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)\<lparr>NTMap\<rparr>"
	+ by (rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ (
	+ use assms(2) in
	+ \<open>cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	+ )+
	+qed simp_all
	+
	+lemmas [cat_cs_simps] = is_functor.cf_ntcf_comp_cf_ntcf_const
	+


	subsection\<open>Natural isomorphism\<close>


	text\<open>See Chapter I-4 in \cite{mac_lane_categories_2010}.\<close>

	locale is_iso_ntcf = is_ntcf +
	- assumes iso_ntcf_is_arr_isomorphism[cat_arrow_cs_intros]:
	+ assumes iso_ntcf_is_iso_arr[cat_arrow_cs_intros]:
	"a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"

	syntax "_is_iso_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ : _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o _ : _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
	"CONST is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

	-lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism':
	+lemma (in is_iso_ntcf) iso_ntcf_is_iso_arr':
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> B"
	using assms by (auto intro: cat_arrow_cs_intros)

	lemmas [cat_arrow_cs_intros] =
	- is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
	+ is_iso_ntcf.iso_ntcf_is_iso_arr'

	-lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism'':
	+lemma (in is_iso_ntcf) iso_ntcf_is_iso_arr'':
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "F = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	and "\<BB>' = \<BB>"
	shows "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>'\<^esub> B"
	using assms by (auto intro: cat_arrow_cs_intros)


	text\<open>Rules.\<close>

	lemma (in is_iso_ntcf) is_iso_ntcf_axioms'[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_ntcf_axioms)

	mk_ide rf is_iso_ntcf_def[unfolded is_iso_ntcf_axioms_def]
	\|intro is_iso_ntcfI\|
	\|dest is_iso_ntcfD[dest]\|
	\|elim is_iso_ntcfE[elim]\|

	lemmas [ntcf_cs_intros] = is_iso_ntcfD(1)



	subsection\<open>Inverse natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition inv_ntcf :: "V \<Rightarrow> V"
	where "inv_ntcf \<NN> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<NN>\<lparr>NTDGDom\<rparr>\<lparr>Obj\<rparr>. SOME g. is_inverse (\<NN>\<lparr>NTDGCod\<rparr>) g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)),
	\<NN>\<lparr>NTCod\<rparr>,
	\<NN>\<lparr>NTDom\<rparr>,
	\<NN>\<lparr>NTDGDom\<rparr>,
	\<NN>\<lparr>NTDGCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Slicing.\<close>

	lemma inv_ntcf_components:
	shows "inv_ntcf \<NN>\<lparr>NTMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>\<NN>\<lparr>NTDGDom\<rparr>\<lparr>Obj\<rparr>. SOME g. is_inverse (\<NN>\<lparr>NTDGCod\<rparr>) g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>))"
	and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTCod\<rparr>"
	and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTDom\<rparr>"
	and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDGDom\<rparr> = \<NN>\<lparr>NTDGDom\<rparr>"
	and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
	unfolding inv_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Components.\<close>

	lemma (in is_iso_ntcf) is_iso_ntcf_inv_ntcf_components[cat_cs_simps]:
	"inv_ntcf \<NN>\<lparr>NTDom\<rparr> = \<GG>"
	"inv_ntcf \<NN>\<lparr>NTCod\<rparr> = \<FF>"
	"inv_ntcf \<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
	"inv_ntcf \<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
	unfolding inv_ntcf_components by (simp_all add: cat_cs_simps)


	subsubsection\<open>Natural transformation map\<close>

	lemma inv_ntcf_NTMap_vsv[cat_cs_intros]: "vsv (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
	unfolding inv_ntcf_components by auto

	lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_inverse[cat_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	proof-
	from assms is_iso_ntcf_axioms have "\<exists>g. is_inverse \<BB> g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" by auto
	from assms someI2_ex[OF this] show
	"is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	unfolding inv_ntcf_components by (simp add: cat_cs_simps)
	qed

	lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse[cat_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>"
	proof-
	have "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	by (rule iso_ntcf_inv_ntcf_NTMap_app_is_inverse[OF assms])
	from NTDom.HomCod.cat_is_inverse_eq_the_inverse[OF this] show ?thesis .
	qed

	lemmas [cat_cs_simps] = is_iso_ntcf.iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse

	lemma (in is_ntcf) inv_ntcf_NTMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	unfolding inv_ntcf_components by (simp add: cat_cs_simps)

	lemmas [cat_cs_simps] = is_ntcf.inv_ntcf_NTMap_vdomain

	lemma (in is_iso_ntcf) inv_ntcf_NTMap_vrange:
	"\<R>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	proof(rule vsubsetI)
	interpret inv_\<NN>: vsv \<open>inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<close> by (rule inv_ntcf_NTMap_vsv)
	fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
	then obtain a
	where f_def: "f = inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
	by (blast elim: inv_\<NN>.vrange_atE)
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
	then have "is_inverse \<BB> f (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	unfolding f_def by (intro iso_ntcf_inv_ntcf_NTMap_app_is_inverse)
	then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto
	qed


	subsubsection\<open>Opposite natural isomorphism\<close>

	lemma (in is_iso_ntcf) is_iso_ntcf_op:
	"op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	proof-
	from is_iso_ntcf_axioms have
	"op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	then show ?thesis
	by (intro is_iso_ntcfI) (auto simp: cat_op_simps cat_arrow_cs_intros)
	qed

	lemma (in is_iso_ntcf) is_iso_ntcf_op'[cat_op_intros]:
	assumes "\<GG>' = op_cf \<GG>"
	and "\<FF>' = op_cf \<FF>"
	and "\<AA>' = op_cat \<AA>"
	and "\<BB>' = op_cat \<BB>"
	shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_ntcf_op)

	lemmas is_iso_ntcf_op[cat_op_intros] = is_iso_ntcf.is_iso_ntcf_op



	subsection\<open>A natural isomorphism is an isomorphism in the category \<open>Funct\<close>\<close>

	text\<open>
	The results that are presented in this subsection can be found in
	nLab (see \cite{noauthor_nlab_nodate}\footnote{\url{
	https://ncatlab.org/nlab/show/natural+isomorphism
	}}).
	\<close>

	-lemma is_arr_isomorphism_is_iso_ntcf:
	+lemma is_iso_arr_is_iso_ntcf:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> = ntcf_id \<GG>"
	and "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<MM> by (rule assms(2))
	show ?thesis
	proof(rule is_iso_ntcfI)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- proof(rule is_arr_isomorphismI)
	+ proof(rule is_iso_arrI)
	show "is_inverse \<BB> (\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	proof(rule is_inverseI)
	from prems have
	"\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (simp add: ntcf_vcomp_NTMap_app[OF assms(2,1) prems])
	also have "\<dots> = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" unfolding assms(4) by simp
	also from prems \<NN>.NTDom.ntcf_id_NTMap_app_vdomain have
	"\<dots> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	unfolding ntcf_id_components by auto
	finally show "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>".
	from prems have
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (simp add: ntcf_vcomp_NTMap_app[OF assms(1,2) prems])
	also have "\<dots> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" unfolding assms(3) by simp
	also from prems \<NN>.NTCod.ntcf_id_NTMap_app_vdomain have
	"\<dots> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	unfolding ntcf_id_components by auto
	finally show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>".
	qed (auto simp: prems cat_cs_intros)
	qed (auto simp: prems cat_cs_intros)
	qed (auto simp: cat_cs_intros)
	qed

	-lemma iso_ntcf_is_arr_isomorphism:
	+lemma iso_ntcf_is_iso_arr:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [ntcf_cs_intros]: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
	and "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	proof-

	interpret is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))

	define m where "m a = inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" for a
	have is_inverse[intro]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> is_inverse \<BB> (m a) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	for a
	unfolding m_def by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have [dest, intro, simp]:
	"a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" for a
	proof-
	assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	from prems have "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (auto intro: cat_cs_intros cat_arrow_cs_intros)
	with is_inverse[OF prems] show "m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	meson
	- NTDom.HomCod.cat_is_inverse_is_arr_isomorphism is_arr_isomorphismD
	+ NTDom.HomCod.cat_is_inverse_is_iso_arr is_iso_arrD
	)
	qed
	have [intro]:
	"f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow> m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
	for f a b
	proof-
	assume prems: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	then have ma: "m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and mb: "m b : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<GG>f: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<NN>a: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and \<FF>f: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<NN>b: "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (auto intro: cat_cs_intros)
	then have \<NN>b\<FF>f:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (auto intro: cat_cs_intros)
	from prems have inv_ma: "is_inverse \<BB> (m a) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	and inv_mb: "is_inverse \<BB> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (m b)"
	by (auto simp: is_inverse_sym)
	from mb have mb_\<NN>b: "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by (auto intro: is_inverse_Comp_CId_right[OF inv_mb])
	from prems have \<NN>a_ma: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	using \<NN>a inv_ma ma by (meson is_inverse_Comp_CId_right)
	from \<GG>f have "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a))"
	unfolding \<NN>a_ma by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	also have "\<dots> = m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ((\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a)"
	by
	(
	metis
	- ma \<GG>f \<NN>a NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
	+ ma \<GG>f \<NN>a NTDom.HomCod.cat_Comp_assoc is_iso_arrD(1)
	)
	also from prems have
	"\<dots> = m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a)"
	by (metis ntcf_Comp_commute)
	also have "\<dots> = (m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
	by
	(
	metis
	- \<NN>b\<FF>f ma mb NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
	+ \<NN>b\<FF>f ma mb NTDom.HomCod.cat_Comp_assoc is_iso_arrD(1)
	)
	also from \<FF>f \<NN>b mb NTDom.HomCod.cat_Comp_assoc have
	"\<dots> = ((m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
	- by (metis is_arr_isomorphismD(1))
	+ by (metis is_iso_arrD(1))
	also from \<FF>f have "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
	unfolding mb_\<NN>b by (simp add: cat_cs_simps)
	finally show "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a" by simp
	qed

	show \<MM>: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(intro is_iso_ntcfI is_ntcfI', unfold m_def[symmetric])
	show "vfsequence (inv_ntcf \<NN>)" unfolding inv_ntcf_def by simp
	show "vcard (inv_ntcf \<NN>) = 5\<^sub>\<nat>"
	unfolding inv_ntcf_def by (simp add: nat_omega_simps)
	qed (auto simp: cat_cs_simps intro: cat_cs_intros)

	interpret \<MM>: is_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close> by (rule \<MM>)

	show \<NN>\<MM>: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
	proof(rule ntcf_eqI)
	from NTCod.cf_ntcf_id_is_ntcf show "ntcf_id \<GG> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr>)"
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding ntcf_vcomp_NTMap_vdomain[OF \<MM>.is_ntcf_axioms] by simp
	then show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	qed
	(
	auto
	simp: ntsmcf_vcomp_components(1) cat_cs_simps
	intro: cat_cs_intros
	)
	qed (auto intro: cat_cs_intros)

	show \<MM>\<NN>: "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	proof(rule ntcf_eqI)
	show "(inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI)
	show "\<D>\<^sub>\<circ> ((inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
	by (simp add: ntsmcf_vcomp_components(1) cat_cs_simps)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
	then show "(inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	qed
	(
	auto simp:
	ntsmcf_vcomp_components(1)
	ntcf_id_components(1)
	cat_cs_simps
	intro: vsv_vcomp
	)
	qed (auto intro: cat_cs_intros)
	qed


	+subsubsection\<open>
	+The operation of taking the inverse natural transformation is an involution
	+\<close>
	+
	+lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_inv_ntcf[ntcf_cs_simps]:
	+ "inv_ntcf (inv_ntcf \<NN>) = \<NN>"
	+proof(rule ntcf_eqI)
	+ show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: cat_cs_intros)
	+ show "inv_ntcf (inv_ntcf \<NN>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_intro: ntcf_cs_intros cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> (inv_ntcf (inv_ntcf \<NN>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "inv_ntcf (inv_ntcf \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold cat_cs_simps dom_lhs)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ then show "inv_ntcf (inv_ntcf \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_arrow_cs_intros ntcf_cs_intros cat_cs_intros
	+ )
	+ qed (auto intro: cat_cs_intros)
	+qed simp_all
	+
	+lemmas [ntcf_cs_simps] = is_iso_ntcf.iso_ntcf_inv_ntcf_inv_ntcf
	+
	+
	+subsubsection\<open>Natural isomorphisms from natural transformations\<close>
	+
	+lemma iso_ntcf_if_is_inverse:
	+ assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> is_inverse \<BB> (\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	+ shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> = inv_ntcf \<NN>"
	+ and "\<NN> = inv_ntcf \<MM>"
	+proof-
	+ interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	+ interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<MM> by (rule assms(2))
	+ show \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ proof(intro is_iso_ntcfI assms(1))
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ rule is_iso_arrI[
	+ OF \<NN>.ntcf_NTMap_is_arr[OF prems] assms(3)[OF prems]
	+ ]
	+ )
	+ qed
	+ show \<MM>: "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ proof(intro is_iso_ntcfI assms(2))
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ show "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ rule is_iso_arrI
	+ [
	+ OF
	+ \<MM>.ntcf_NTMap_is_arr[OF prems]
	+ is_inverse_sym[THEN iffD1, OF assms(3)[OF prems]]
	+ ]
	+ )
	+ qed
	+ have \<MM>_NTMap_unique: "g = \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "is_inverse \<BB> g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" for g a
	+ by (rule \<NN>.NTDom.HomCod.cat_is_inverse_eq[OF that(2) assms(3)[OF that(1)]])
	+ show "\<MM> = inv_ntcf \<NN>"
	+ proof(rule ntcf_eqI, rule assms(2))
	+ from \<NN> show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_intro: ntcf_cs_intros)
	+ show "\<MM>\<lparr>NTMap\<rparr> = inv_ntcf \<NN>\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold cat_cs_simps)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ show "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ proof(intro \<MM>_NTMap_unique[symmetric] prems)
	+ from prems assms(3)[OF prems] show
	+ "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	+ unfolding inv_ntcf_components cat_cs_simps
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: V_cs_intros cs_simp: some_eq_ex V_cs_simps
	+ )
	+ qed
	+ qed (auto simp: inv_ntcf_components)
	+ qed simp_all
	+ then have "inv_ntcf (inv_ntcf \<NN>) = inv_ntcf \<MM>" by simp
	+ from this \<MM> \<NN> show "\<NN> = inv_ntcf \<MM>"
	+ by (cs_prems cs_shallow cs_simp: ntcf_cs_simps)
	+qed
	+
	+
	subsubsection\<open>Vertical composition of natural isomorphisms\<close>

	lemma ntcf_vcomp_is_iso_ntcf[cat_cs_intros]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	-proof(intro is_arr_isomorphism_is_iso_ntcf)
	- note inv_ntcf_\<MM> = iso_ntcf_is_arr_isomorphism[OF assms(1)]
	- and inv_ntcf_\<NN> = iso_ntcf_is_arr_isomorphism[OF assms(2)]
	+proof(intro is_iso_arr_is_iso_ntcf)
	+ note inv_ntcf_\<MM> = iso_ntcf_is_iso_arr[OF assms(1)]
	+ and inv_ntcf_\<NN> = iso_ntcf_is_iso_arr[OF assms(2)]
	note [cat_cs_simps] = inv_ntcf_\<MM>(2,3) inv_ntcf_\<NN>(2,3)
	from assms show "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	from inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) show
	"inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have
	"\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>) =
	\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>"
	by
	(
	cs_concl
	cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
	)
	also from assms have "\<dots> = ntcf_id \<HH>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
	finally show "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>) = ntcf_id \<HH>"
	by simp
	from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have
	"inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
	inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	by
	(
	cs_concl
	cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
	)
	also from assms have "\<dots> = ntcf_id \<FF>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
	finally show "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_id \<FF>"
	by simp
	qed


	subsubsection\<open>Horizontal composition of natural isomorphisms\<close>

	lemma ntcf_hcomp_is_iso_ntcf:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof(intro is_arr_isomorphism_is_iso_ntcf)
	- note inv_ntcf_\<MM> = iso_ntcf_is_arr_isomorphism[OF assms(1)]
	- and inv_ntcf_\<NN> = iso_ntcf_is_arr_isomorphism[OF assms(2)]
	+proof(intro is_iso_arr_is_iso_ntcf)
	+ note inv_ntcf_\<MM> = iso_ntcf_is_iso_arr[OF assms(1)]
	+ and inv_ntcf_\<NN> = iso_ntcf_is_iso_arr[OF assms(2)]
	note [cat_cs_simps] = inv_ntcf_\<MM>(2,3) inv_ntcf_\<NN>(2,3)
	from assms show "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	from inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) show
	"inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> : \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have
	"\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) =
	ntcf_id \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<GG>"
	by
	(
	cs_concl
	cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
	cs_intro: ntcf_cs_intros
	)
	also from assms have "\<dots> = ntcf_id (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros
	)
	finally show
	"\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) = ntcf_id (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)"
	by simp
	from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have
	"inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
	ntcf_id \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
	by
	(
	cs_concl
	cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
	cs_intro: ntcf_cs_intros
	)
	also from assms have "\<dots> = ntcf_id (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
	finally show
	"inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_id (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)"
	by simp
	qed

	lemma ntcf_hcomp_is_iso_ntcf'[ntcf_cs_intros]:
	assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<HH>' = \<FF>' \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<HH>'' = \<GG>' \<circ>\<^sub>C\<^sub>F \<GG>"
	shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<HH>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH>'' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_iso_ntcf)


	+subsubsection\<open>Composition of a natural isomorphism and a functor\<close>
	+
	+lemma ntcf_cf_comp_is_iso_ntcf:
	+ assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_iso_ntcfI ntcf_cf_comp_is_ntcf)
	+ interpret \<NN>: is_iso_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	+ show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule \<NN>.is_ntcf_axioms)
	+ fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ with assms(2) show
	+ "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : (\<FF> \<circ>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	+ )
	+qed (rule assms(2))
	+
	+lemma ntcf_cf_comp_is_iso_ntcf'[cat_cs_intros]:
	+ assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<FF>' = \<FF> \<circ>\<^sub>C\<^sub>F \<HH>"
	+ and "\<GG>' = \<GG> \<circ>\<^sub>C\<^sub>F \<HH>"
	+ shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ using assms(1,2) unfolding assms(3,4) by (rule ntcf_cf_comp_is_iso_ntcf)
	+
	+
	subsubsection\<open>An identity natural transformation is a natural isomorphism\<close>

	lemma (in is_functor) cf_ntcf_id_is_iso_ntcf:
	"ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	have "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (auto intro: cat_cs_intros)
	moreover then have "ntcf_id \<FF> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = ntcf_id \<FF>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- ultimately show ?thesis by (auto intro: is_arr_isomorphism_is_iso_ntcf)
	+ ultimately show ?thesis by (auto intro: is_iso_arr_is_iso_ntcf)
	qed

	lemma (in is_functor) cf_ntcf_id_is_iso_ntcf'[ntcf_cs_intros]:
	assumes "\<GG>' = \<FF>" and "\<HH>' = \<FF>"
	shows "ntcf_id \<FF> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule cf_ntcf_id_is_iso_ntcf)

	lemmas [ntcf_cs_intros] = is_functor.cf_ntcf_id_is_iso_ntcf'



	subsection\<open>Functor isomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See subsection 1.5 in \cite{bodo_categories_1970}.\<close>

	locale iso_functor =
	fixes \<alpha> \<FF> \<GG>
	assumes iso_cf_is_iso_ntcf: "\<exists>\<AA> \<BB> \<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"

	notation iso_functor (infixl "\<approx>\<^sub>C\<^sub>F\<index>" 50)


	text\<open>Rules.\<close>

	lemma iso_functorI:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	using assms unfolding iso_functor_def by auto

	lemma iso_functorD[dest]:
	assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	shows "\<exists>\<AA> \<BB> \<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_functor_def by auto

	lemma iso_functorE[elim]:
	assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	obtains \<AA> \<BB> \<NN> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_functor_def by auto


	subsubsection\<open>A functor isomorphism is an equivalence relation\<close>

	lemma iso_functor_refl:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
	proof(rule iso_functorI)
	from assms show "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (cs_concl cs_shallow cs_intro: ntcf_cs_intros)
	qed

	lemma iso_functor_sym[sym]:
	assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	shows "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
	proof-
	from assms obtain \<AA> \<BB> \<NN> where \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
	- from iso_ntcf_is_arr_isomorphism(1)[OF \<NN>] show "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
	+ from iso_ntcf_is_iso_arr(1)[OF \<NN>] show "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
	by (auto simp: iso_functorI)
	qed

	lemma iso_functor_trans[trans, intro]:
	assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>" and "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<HH>"
	shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<HH>"
	proof-
	from assms(1) obtain \<AA> \<BB> \<NN> where \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	moreover from assms(2) obtain \<AA>' \<BB>' \<MM>
	where \<MM>: "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	by auto
	ultimately have "\<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by blast+
	then have eq: "\<AA>' = \<AA>" "\<BB>' = \<BB>" by auto
	from \<MM> have \<MM>: "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" unfolding eq .
	from ntcf_vcomp_is_iso_ntcf[OF \<MM> \<NN>] show ?thesis by (rule iso_functorI)
	qed


	subsubsection\<open>Opposite functor isomorphism\<close>

	lemma (in iso_functor) iso_functor_op: "op_cf \<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<GG>"
	proof-
	from iso_functor_axioms obtain \<AA> \<BB> \<NN> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto
	from is_iso_ntcf_op[OF this] have "op_cf \<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<FF>"
	by (auto simp: iso_functorI)
	then show "op_cf \<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<GG>" by (rule iso_functor_sym)
	qed

	lemmas iso_functor_op[cat_op_intros] = iso_functor.iso_functor_op

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
	@@ -1,5909 +1,5909 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Product category\<close>
	theory CZH_ECAT_PCategory
	imports
	CZH_ECAT_NTCF
	CZH_ECAT_Small_Category
	CZH_Foundations.CZH_SMC_PSemicategory
	begin



	subsection\<open>Background\<close>


	text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>

	named_theorems cat_prod_cs_simps
	named_theorems cat_prod_cs_intros



	subsection\<open>Product category: definition and elementary properties\<close>

	definition cat_prod :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "cat_prod I \<AA> =
	[
	(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>),
	(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>),
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Dom\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>)),
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Cod\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>)),
	(
	\<lambda>gf\<in>\<^sub>\<circ>composable_arrs (dg_prod I \<AA>).
	(\<lambda>i\<in>\<^sub>\<circ>I. vpfst gf\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> i\<^esub> vpsnd gf\<lparr>i\<rparr>)
	),
	(\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>))
	]\<^sub>\<circ>"

	syntax "_PCATEGORY" :: "pttrn \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	("(3\<Prod>\<^sub>C_\<in>\<^sub>\<circ>_./ _)" [0, 0, 10] 10)
	translations "\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA>" \<rightleftharpoons> "CONST cat_prod I (\<lambda>i. \<AA>)"


	text\<open>Components.\<close>

	lemma cat_prod_components:
	shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>)"
	and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
	and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Dom\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Dom\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>))"
	and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Cod\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Cod\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>))"
	and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Comp\<rparr> =
	(
	\<lambda>gf\<in>\<^sub>\<circ>composable_arrs (dg_prod I \<AA>).
	(\<lambda>i\<in>\<^sub>\<circ>I. vpfst gf\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> i\<^esub> vpsnd gf\<lparr>i\<rparr>)
	)"
	and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>))"
	unfolding cat_prod_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_prod[slicing_commute]:
	"smc_prod I (\<lambda>i. cat_smc (\<AA> i)) = cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	unfolding dg_prod_def cat_smc_def cat_prod_def smc_prod_def dg_field_simps
	by (simp_all add: nat_omega_simps)

	context
	fixes \<AA> \<phi> :: "V \<Rightarrow> V"
	and \<CC> :: V
	begin

	lemmas_with [
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>, unfolded slicing_simps slicing_commute
	]:
	cat_prod_ObjI = smc_prod_ObjI
	and cat_prod_ObjD = smc_prod_ObjD
	and cat_prod_ObjE = smc_prod_ObjE
	and cat_prod_Obj_cong = smc_prod_Obj_cong
	and cat_prod_ArrI = smc_prod_ArrI
	and cat_prod_ArrD = smc_prod_ArrD
	and cat_prod_ArrE = smc_prod_ArrE
	and cat_prod_Arr_cong = smc_prod_Arr_cong
	and cat_prod_Dom_vsv[cat_cs_intros] = smc_prod_Dom_vsv
	and cat_prod_Dom_vdomain[cat_cs_simps] = smc_prod_Dom_vdomain
	and cat_prod_Dom_app = smc_prod_Dom_app
	and cat_prod_Dom_app_component_app[cat_cs_simps] =
	smc_prod_Dom_app_component_app
	and cat_prod_Cod_vsv[cat_cs_intros] = smc_prod_Cod_vsv
	and cat_prod_Cod_app = smc_prod_Cod_app
	and cat_prod_Cod_vdomain[cat_cs_simps] = smc_prod_Cod_vdomain
	and cat_prod_Cod_app_component_app[cat_cs_simps] =
	smc_prod_Cod_app_component_app
	and cat_prod_Comp = smc_prod_Comp
	and cat_prod_Comp_vdomain[cat_cs_simps] = smc_prod_Comp_vdomain
	and cat_prod_Comp_app = smc_prod_Comp_app
	and cat_prod_Comp_app_component[cat_cs_simps] =
	smc_prod_Comp_app_component
	and cat_prod_Comp_app_vdomain = smc_prod_Comp_app_vdomain
	and cat_prod_vunion_Obj_in_Obj = smc_prod_vunion_Obj_in_Obj
	and cat_prod_vdiff_vunion_Obj_in_Obj = smc_prod_vdiff_vunion_Obj_in_Obj
	and cat_prod_vunion_Arr_in_Arr = smc_prod_vunion_Arr_in_Arr
	and cat_prod_vdiff_vunion_Arr_in_Arr = smc_prod_vdiff_vunion_Arr_in_Arr

	end



	subsection\<open>Local assumptions for a product category\<close>

	locale pcategory_base = \<Z> \<alpha> for \<alpha> I \<AA> +
	assumes pcat_categories: "i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
	and pcat_index_in_Vset[cat_cs_intros]: "I \<in>\<^sub>\<circ> Vset \<alpha>"

	lemma (in pcategory_base) pcat_categories'[cat_prod_cs_intros]:
	assumes "i \<in>\<^sub>\<circ> I" and "\<alpha>' = \<alpha>"
	shows "category \<alpha>' (\<AA> i)"
	using assms(1) unfolding assms(2) by (rule pcat_categories)


	text\<open>Rules.\<close>

	lemma (in pcategory_base) pcategory_base_axioms'[cat_prod_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "I' = I"
	shows "pcategory_base \<alpha>' I' \<AA>"
	unfolding assms by (rule pcategory_base_axioms)

	mk_ide rf pcategory_base_def[unfolded pcategory_base_axioms_def]
	\|intro pcategory_baseI\|
	\|dest pcategory_baseD[dest]\|
	\|elim pcategory_baseE[elim]\|

	lemma pcategory_base_psemicategory_baseI:
	assumes "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
	shows "pcategory_base \<alpha> I \<AA>"
	proof-
	interpret psemicategory_base \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
	show ?thesis
	by (intro pcategory_baseI)
	(auto simp: assms(2) psmc_index_in_Vset psmc_Obj_in_Vset psmc_Arr_in_Vset)
	qed


	text\<open>Product category is a product semicategory.\<close>

	context pcategory_base
	begin

	lemma pcat_psemicategory_base: "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	proof(intro psemicategory_baseI)
	from pcat_index_in_Vset show "I \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed (auto simp: category.cat_semicategory cat_prod_cs_intros)

	interpretation psmc: psemicategory_base \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	by (rule pcat_psemicategory_base)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	pcat_Obj_in_Vset = psmc.psmc_Obj_in_Vset
	and pcat_Arr_in_Vset = psmc.psmc_Arr_in_Vset
	and pcat_smc_prod_Obj_in_Vset = psmc.psmc_smc_prod_Obj_in_Vset
	and pcat_smc_prod_Arr_in_Vset = psmc.psmc_smc_prod_Arr_in_Vset
	and cat_prod_Dom_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Dom_app_in_Obj
	and cat_prod_Cod_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Cod_app_in_Obj
	and cat_prod_is_arrI = psmc.smc_prod_is_arrI
	and cat_prod_is_arrD[dest] = psmc.smc_prod_is_arrD
	and cat_prod_is_arrE[elim] = psmc.smc_prod_is_arrE

	end

	lemma cat_prod_dg_prod_is_arr:
	"g : b \<mapsto>\<^bsub>dg_prod I \<AA>\<^esub> c \<longleftrightarrow> g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c"
	unfolding is_arr_def cat_prod_def smc_prod_def dg_prod_def dg_field_simps
	by (simp add: nat_omega_simps)

	lemma smc_prod_composable_arrs_dg_prod:
	"composable_arrs (dg_prod I \<AA>) = composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	unfolding composable_arrs_def cat_prod_dg_prod_is_arr by simp


	text\<open>Elementary properties.\<close>

	lemma (in pcategory_base) pcat_vsubset_index_pcategory_base:
	assumes "J \<subseteq>\<^sub>\<circ> I"
	shows "pcategory_base \<alpha> J \<AA>"
	proof(intro pcategory_baseI)
	show "category \<alpha> (\<AA> i)" if "i \<in>\<^sub>\<circ> J" for i
	using that assms by (auto intro: cat_prod_cs_intros)
	from assms show "J \<in>\<^sub>\<circ> Vset \<alpha>" by (simp add: vsubset_in_VsetI cat_cs_intros)
	qed auto


	subsubsection\<open>Identity\<close>

	lemma cat_prod_CId_vsv[cat_cs_intros]: "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
	unfolding cat_prod_components by auto

	lemma cat_prod_CId_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by simp

	lemma cat_prod_CId_app:
	assumes "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
	shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr> = (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>)"
	using assms unfolding cat_prod_components by simp

	lemma cat_prod_CId_app_component[cat_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" and "i \<in>\<^sub>\<circ> I"
	shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>"
	using assms unfolding cat_prod_components by simp

	lemma (in pcategory_base) cat_prod_CId_vrange:
	"\<R>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
	proof(intro vsubsetI)
	interpret CId: vsv \<open>((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)\<close> by (rule cat_prod_CId_vsv)
	fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
	then obtain a where f_def: "f = ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)\<lparr>a\<rparr>"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
	by (blast dest: CId.vrange_atD)
	then have a: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by simp
	show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
	unfolding f_def cat_prod_CId_app[OF a]
	proof(rule VLambda_in_vproduct)
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	interpret \<AA>: category \<alpha> \<open>\<AA> i\<close>
	by (simp add: \<open>i \<in>\<^sub>\<circ> I\<close> cat_cs_intros cat_prod_cs_intros)
	from prems a have "a\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>" unfolding cat_prod_components by auto
	with is_arrD(1) show "\<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Arr\<rparr>"
	by (auto intro: cat_cs_intros)
	qed
	qed


	subsubsection\<open>A product \<open>\<alpha>\<close>-category is a tiny \<open>\<beta>\<close>-category\<close>

	lemma (in pcategory_base) pcat_tiny_category_cat_prod:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_category \<beta> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))

	show ?thesis
	proof(intro tiny_categoryI, (unfold slicing_simps)?)

	show \<Pi>: "tiny_semicategory \<beta> (cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i))"
	unfolding slicing_commute[symmetric]
	by
	(
	intro psemicategory_base.psmc_tiny_semicategory_smc_prod;
	(rule assms pcat_psemicategory_base)?
	)
	interpret \<Pi>: tiny_semicategory \<beta> \<open>cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> by (rule \<Pi>)

	show "vfsequence (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" unfolding cat_prod_def by auto
	show "vcard (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) = 6\<^sub>\<nat>"
	unfolding cat_prod_def by (simp add: nat_omega_simps)

	show CId: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> a"
	if a: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" for a
	proof(rule cat_prod_is_arrI)
	have [cat_cs_intros]: "a\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>" if i: "i \<in>\<^sub>\<circ> I" for i
	by (rule cat_prod_ObjD(3)[OF a i])
	from that show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> : a\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> a\<lparr>i\<rparr>"
	if "i \<in>\<^sub>\<circ> I" for i
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros that
	)
	qed (use that in \<open>auto simp: cat_prod_components cat_prod_CId_app that\<close>)

	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f = f"
	if "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b" for f a b
	proof(rule cat_prod_Arr_cong)
	note f = \<Pi>.smc_is_arrD[unfolded slicing_simps, OF that]
	note a = f(2) and b = f(3) and f = f(1)
	from CId[OF b] have CId_b:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b"
	by simp
	from \<Pi>.smc_Comp_is_arr[unfolded slicing_simps, OF this that] show
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	by (simp add: cat_cs_intros)
	from that show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>" by auto
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: prems cat_prod_cs_intros)
	from prems cat_prod_is_arrD(7)[OF that] have fi:
	"f\<lparr>i\<rparr> : a\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> b\<lparr>i\<rparr>"
	by auto
	from prems show "((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f)\<lparr>i\<rparr> = f\<lparr>i\<rparr>"
	unfolding cat_prod_Comp_app_component[OF CId_b that prems]
	unfolding cat_prod_CId_app[OF b]
	by (auto intro: \<AA>i.cat_CId_left_left[OF fi])
	qed

	show "f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	if "f : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c" for f b c
	proof(rule cat_prod_Arr_cong)
	note f = \<Pi>.smc_is_arrD[unfolded slicing_simps, OF that]
	note b = f(2) and c = f(3) and f = f(1)
	from CId[OF b] have CId_b:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b"
	by simp
	from \<Pi>.smc_Comp_is_arr[unfolded slicing_simps, OF that this] show
	"f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	by (simp add: cat_cs_intros)
	from that show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>" by auto
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: prems cat_prod_cs_intros)
	from prems cat_prod_is_arrD[OF that] have fi: "f\<lparr>i\<rparr> : b\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> c\<lparr>i\<rparr>"
	by simp
	from prems show "(f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>i\<rparr> = f\<lparr>i\<rparr>"
	unfolding cat_prod_Comp_app_component[OF that CId_b prems]
	unfolding cat_prod_CId_app[OF b]
	by (auto intro: \<AA>i.cat_CId_right_left[OF fi])
	qed

	qed (auto simp: cat_cs_intros cat_cs_simps intro: cat_cs_intros)

	qed



	subsection\<open>Further local assumptions for product categories\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale pcategory = pcategory_base \<alpha> I \<AA> for \<alpha> I \<AA> +
	assumes pcat_Obj_vsubset_Vset: "J \<subseteq>\<^sub>\<circ> I \<Longrightarrow> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and pcat_Hom_vifunion_in_Vset:
	"\<lbrakk>
	J \<subseteq>\<^sub>\<circ> I;
	A \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr>;
	B \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr>;
	A \<in>\<^sub>\<circ> Vset \<alpha>;
	B \<in>\<^sub>\<circ> Vset \<alpha>
	\<rbrakk> \<Longrightarrow> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i) a b) \<in>\<^sub>\<circ> Vset \<alpha>"


	text\<open>Rules.\<close>

	lemma (in pcategory) pcategory_axioms'[cat_prod_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "I' = I"
	shows "pcategory \<alpha>' I' \<AA>"
	unfolding assms by (rule pcategory_axioms)

	mk_ide rf pcategory_def[unfolded pcategory_axioms_def]
	\|intro pcategoryI\|
	\|dest pcategoryD[dest]\|
	\|elim pcategoryE[elim]\|

	lemmas [cat_prod_cs_intros] = pcategoryD(1)

	lemma pcategory_psemicategoryI:
	assumes "psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
	shows "pcategory \<alpha> I \<AA>"
	proof-
	interpret psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
	note [unfolded slicing_simps slicing_commute, cat_cs_intros] =
	psmc_Obj_vsubset_Vset
	psmc_Hom_vifunion_in_Vset
	show ?thesis
	by (intro pcategoryI pcategory_base_psemicategory_baseI)
	(auto simp: assms(2) smc_prod_cs_intros intro!: cat_cs_intros)
	qed


	text\<open>Product category is a product semicategory.\<close>

	context pcategory
	begin

	lemma pcat_psemicategory: "psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	proof(intro psemicategoryI, unfold slicing_simps slicing_commute)
	show "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	by (rule pcat_psemicategory_base)
	qed (auto intro!: pcat_Obj_vsubset_Vset pcat_Hom_vifunion_in_Vset)

	interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	by (rule pcat_psemicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	pcat_Obj_vsubset_Vset' = psmc.psmc_Obj_vsubset_Vset'
	and pcat_Hom_vifunion_in_Vset' = psmc.psmc_Hom_vifunion_in_Vset'
	and pcat_cat_prod_vunion_is_arr = psmc.psmc_smc_prod_vunion_is_arr
	and pcat_cat_prod_vdiff_vunion_is_arr = psmc.psmc_smc_prod_vdiff_vunion_is_arr

	lemmas_with [unfolded slicing_simps slicing_commute]:
	pcat_cat_prod_vunion_Comp = psmc.psmc_smc_prod_vunion_Comp
	and pcat_cat_prod_vdiff_vunion_Comp = psmc.psmc_smc_prod_vdiff_vunion_Comp

	end


	text\<open>Elementary properties.\<close>

	lemma (in pcategory) pcat_vsubset_index_pcategory:
	assumes "J \<subseteq>\<^sub>\<circ> I"
	shows "pcategory \<alpha> J \<AA>"
	proof(intro pcategoryI pcategory_psemicategoryI)
	show "cat_prod J' \<AA>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>" if \<open>J' \<subseteq>\<^sub>\<circ> J\<close> for J'
	proof-
	from that assms have "J' \<subseteq>\<^sub>\<circ> I" by simp
	then show "cat_prod J' \<AA>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>" by (rule pcat_Obj_vsubset_Vset)
	qed
	fix A B J' assume prems:
	"J' \<subseteq>\<^sub>\<circ> J"
	"A \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i)\<lparr>Obj\<rparr>"
	"B \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i)\<lparr>Obj\<rparr>"
	"A \<in>\<^sub>\<circ> Vset \<alpha>"
	"B \<in>\<^sub>\<circ> Vset \<alpha>"
	show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from prems(1) assms have "J' \<subseteq>\<^sub>\<circ> I" by simp
	from pcat_Hom_vifunion_in_Vset[OF this prems(2-5)] show ?thesis.
	qed

	qed (rule pcat_vsubset_index_pcategory_base[OF assms])


	subsubsection\<open>A product \<open>\<alpha>\<close>-category is an \<open>\<alpha>\<close>-category\<close>

	lemma (in pcategory) pcat_category_cat_prod: "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	proof-
	interpret tiny_category \<open>\<alpha> + \<omega>\<close> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i\<close>
	by (intro pcat_tiny_category_cat_prod)
	(auto simp: \<Z>_\<alpha>_\<alpha>\<omega> \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega>)
	show ?thesis
	by (rule category_if_category)
	(
	auto
	intro!: pcat_Hom_vifunion_in_Vset pcat_Obj_vsubset_Vset
	intro: cat_cs_intros
	)
	qed



	subsection\<open>Local assumptions for a finite product category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale finite_pcategory = pcategory_base \<alpha> I \<AA> for \<alpha> I \<AA> +
	assumes fin_pcat_index_vfinite: "vfinite I"


	text\<open>Rules.\<close>

	lemma (in finite_pcategory) finite_pcategory_axioms[cat_prod_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "I' = I"
	shows "finite_pcategory \<alpha>' I' \<AA>"
	unfolding assms by (rule finite_pcategory_axioms)

	mk_ide rf finite_pcategory_def[unfolded finite_pcategory_axioms_def]
	\|intro finite_pcategoryI\|
	\|dest finite_pcategoryD[dest]\|
	\|elim finite_pcategoryE[elim]\|

	lemmas [cat_prod_cs_intros] = finite_pcategoryD(1)

	lemma finite_pcategory_finite_psemicategoryI:
	assumes "finite_psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
	shows "finite_pcategory \<alpha> I \<AA>"
	proof-
	interpret finite_psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
	show ?thesis
	by
	(
	intro
	assms
	finite_pcategoryI
	pcategory_base_psemicategory_baseI
	finite_psemicategoryD(1)[OF assms(1)]
	fin_psmc_index_vfinite
	)
	qed


	subsubsection\<open>
	Local assumptions for a finite product semicategory and local
	assumptions for an arbitrary product semicategory
	\<close>

	sublocale finite_pcategory \<subseteq> pcategory \<alpha> I \<AA>
	proof-
	interpret finite_psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	proof(intro finite_psemicategoryI psemicategory_baseI)
	fix i assume "i \<in>\<^sub>\<circ> I"
	then interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: pcat_categories)
	show "semicategory \<alpha> (cat_smc (\<AA> i))" by (simp add: \<AA>i.cat_semicategory)
	qed (auto intro!: cat_cs_intros fin_pcat_index_vfinite)
	show "pcategory \<alpha> I \<AA>"
	by (intro pcategory_psemicategoryI)
	(simp_all add: pcat_categories psemicategory_axioms)
	qed



	subsection\<open>Binary union and complement\<close>

	lemma (in pcategory) pcat_cat_prod_vunion_CId:
	assumes "vdisjnt J K"
	and "J \<subseteq>\<^sub>\<circ> I"
	and "K \<subseteq>\<^sub>\<circ> I"
	and "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>K. \<AA> j)\<lparr>Obj\<rparr>"
	shows
	"(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>K. \<AA> j)\<lparr>CId\<rparr>\<lparr>b\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J \<union>\<^sub>\<circ> K. \<AA> i)\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>"
	proof-

	interpret J\<AA>: pcategory \<alpha> J \<AA>
	using assms(2) by (simp add: pcat_vsubset_index_pcategory)
	interpret K\<AA>: pcategory \<alpha> K \<AA>
	using assms(3) by (simp add: pcat_vsubset_index_pcategory)
	interpret JK\<AA>: pcategory \<alpha> \<open>J \<union>\<^sub>\<circ> K\<close> \<AA>
	using assms(2,3) by (simp add: pcat_vsubset_index_pcategory)

	interpret J\<AA>': category \<alpha> \<open>cat_prod J \<AA>\<close>
	by (rule J\<AA>.pcat_category_cat_prod)
	interpret K\<AA>': category \<alpha> \<open>cat_prod K \<AA>\<close>
	by (rule K\<AA>.pcat_category_cat_prod)
	interpret JK\<AA>': category \<alpha> \<open>cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<close>
	by (rule JK\<AA>.pcat_category_cat_prod)

	from assms(4) have CId_a: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<^esub> a"
	by (auto intro: cat_cs_intros)
	from assms(5) have CId_b: "cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ck\<in>\<^sub>\<circ>K. \<AA> k)\<^esub> b"
	by (auto intro: cat_cs_intros)
	have CId_a_CId_b: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> :
	a \<union>\<^sub>\<circ> b \<mapsto>\<^bsub>cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<^esub> a \<union>\<^sub>\<circ> b"
	by (rule pcat_cat_prod_vunion_is_arr[OF assms(1-3) CId_a CId_b])
	from CId_a have a: "a \<in>\<^sub>\<circ> cat_prod J \<AA>\<lparr>Obj\<rparr>" by (auto intro: cat_cs_intros)
	from CId_b have b: "b \<in>\<^sub>\<circ> cat_prod K \<AA>\<lparr>Obj\<rparr>" by (auto intro: cat_cs_intros)
	from CId_a_CId_b have ab: "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)

	note CId_aD = J\<AA>.cat_prod_is_arrD[OF CId_a]
	and CId_bD = K\<AA>.cat_prod_is_arrD[OF CId_b]

	show ?thesis
	proof(rule cat_prod_Arr_cong[of _ \<open>J \<union>\<^sub>\<circ> K\<close> \<AA>])
	from CId_a_CId_b show
	"cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Arr\<rparr>"
	by auto
	from ab show "cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr> \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Arr\<rparr>"
	by (auto intro: JK\<AA>'.cat_is_arrD(1) cat_cs_intros)
	fix i assume "i \<in>\<^sub>\<circ> J \<union>\<^sub>\<circ> K"
	then consider (iJ) \<open>i \<in>\<^sub>\<circ> J\<close> \| (iK) \<open>i \<in>\<^sub>\<circ> K\<close> by auto
	then show "(cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>i\<rparr> =
	cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>\<lparr>i\<rparr>"
	by cases
	(
	auto simp:
	assms(1)
	CId_aD(1-4)
	CId_bD(1-4)
	cat_prod_CId_app[OF ab]
	cat_prod_CId_app[OF a]
	cat_prod_CId_app[OF b]
	)
	qed

	qed

	lemma (in pcategory) pcat_cat_prod_vdiff_vunion_CId:
	assumes "J \<subseteq>\<^sub>\<circ> I"
	and "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> j)\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
	shows
	"(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> j)\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>b\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>"
	by
	(
	vdiff_of_vunion'
	rule: pcat_cat_prod_vunion_CId assms: assms(2-3) subset: assms(1)
	)



	subsection\<open>Projection\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_proj :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<close>)
	where "\<pi>\<^sub>C I \<AA> i =
	[
	(\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). a\<lparr>i\<rparr>),
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). f\<lparr>i\<rparr>),
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i),
	\<AA> i
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_proj_components:
	shows "\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). a\<lparr>i\<rparr>)"
	and "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). f\<lparr>i\<rparr>)"
	and "\<pi>\<^sub>C I \<AA> i\<lparr>HomDom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	and "\<pi>\<^sub>C I \<AA> i\<lparr>HomCod\<rparr> = \<AA> i"
	unfolding cf_proj_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing\<close>

	lemma cf_smcf_cf_proj[slicing_commute]:
	"\<pi>\<^sub>S\<^sub>M\<^sub>C I (\<lambda>i. cat_smc (\<AA> i)) i = cf_smcf (\<pi>\<^sub>C I \<AA> i)"
	unfolding
	cat_smc_def
	cf_smcf_def
	smcf_proj_def
	cf_proj_def
	cat_prod_def
	smc_prod_def
	dg_prod_def
	dg_field_simps
	dghm_field_simps
	by (simp add: nat_omega_simps)

	context pcategory
	begin

	interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	by (rule pcat_psemicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	pcat_cf_proj_is_semifunctor = psmc.psmc_smcf_proj_is_semifunctor

	end


	subsubsection\<open>Projection functor is a functor\<close>

	lemma (in pcategory) pcat_cf_proj_is_functor:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "\<pi>\<^sub>C I \<AA> i : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	proof(intro is_functorI)
	interpret \<AA>: category \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close>
	by (simp add: pcat_category_cat_prod)
	show "vfsequence (\<pi>\<^sub>C I \<AA> i)" unfolding cf_proj_def by simp
	show "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" by (simp add: \<AA>.category_axioms)
	show "vcard (\<pi>\<^sub>C I \<AA> i) = 4\<^sub>\<nat>"
	unfolding cf_proj_def by (simp add: nat_omega_simps)
	show "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" for c
	proof-
	interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close>
	by (auto intro: assms cat_prod_cs_intros)
	from that have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c"
	by (simp add: \<AA>.cat_CId_is_arr)
	then have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	by (auto intro: cat_cs_intros)
	with assms have
	"\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<lparr>i\<rparr>"
	unfolding cf_proj_components cat_prod_components by simp
	also from assms have "\<dots> = \<AA> i\<lparr>CId\<rparr>\<lparr>c\<lparr>i\<rparr>\<rparr>"
	unfolding cat_prod_CId_app[OF that] by simp
	also from that have "\<dots> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	unfolding cf_proj_components cat_prod_components by simp
	finally show
	"\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	by simp
	qed
	qed
	(
	auto simp:
	assms cf_proj_components pcat_cf_proj_is_semifunctor cat_prod_cs_intros
	)

	lemma (in pcategory) pcat_cf_proj_is_functor':
	assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" and "\<DD> = \<AA> i"
	shows "\<pi>\<^sub>C I \<AA> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1) unfolding assms(2,3) by (rule pcat_cf_proj_is_functor)

	lemmas [cat_cs_intros] = pcategory.pcat_cf_proj_is_functor'



	subsection\<open>Category product universal property functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	text\<open>
	The functor that is presented in this section is used in the proof of
	the universal property of the product category later in this work.
	\<close>

	definition cf_up :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "cf_up I \<AA> \<CC> \<phi> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)),
	(\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)),
	\<CC>,
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_up_components:
	shows "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>))"
	and "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>))"
	and "cf_up I \<AA> \<CC> \<phi>\<lparr>HomDom\<rparr> = \<CC>"
	and "cf_up I \<AA> \<CC> \<phi>\<lparr>HomCod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	unfolding cf_up_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smcf_dghm_cf_up[slicing_commute]:
	"smcf_up I (\<lambda>i. cat_smc (\<AA> i)) (cat_smc \<CC>) (\<lambda>i. cf_smcf (\<phi> i)) =
	cf_smcf (cf_up I \<AA> \<CC> \<phi>)"
	unfolding
	cat_smc_def
	cf_smcf_def
	cf_up_def
	smcf_up_def
	cat_prod_def
	smc_prod_def
	dg_prod_def
	dg_field_simps
	dghm_field_simps
	by (simp add: nat_omega_simps)

	context
	fixes \<AA> \<phi> :: "V \<Rightarrow> V"
	and \<CC> :: V
	begin

	lemmas_with
	[
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> and \<CC> = \<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute
	]:
	cf_up_ObjMap_vdomain[simp] = smcf_up_ObjMap_vdomain
	and cf_up_ObjMap_app = smcf_up_ObjMap_app
	and cf_up_ObjMap_app_vdomain[simp] = smcf_up_ObjMap_app_vdomain
	and cf_up_ObjMap_app_component = smcf_up_ObjMap_app_component
	and cf_up_ArrMap_vdomain[simp] = smcf_up_ArrMap_vdomain
	and cf_up_ArrMap_app = smcf_up_ArrMap_app
	and cf_up_ArrMap_app_vdomain[simp] = smcf_up_ArrMap_app_vdomain
	and cf_up_ArrMap_app_component = smcf_up_ArrMap_app_component

	lemma cf_up_ObjMap_vrange:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	shows "\<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
	proof
	(
	rule smcf_up_ObjMap_vrange[
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>
	and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute
	]
	)
	fix i assume "i \<in>\<^sub>\<circ> I"
	then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms)
	show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
	by (rule cf_is_semifunctor)
	qed

	lemma cf_up_ObjMap_app_vrange:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	shows " \<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>)"
	proof
	(
	rule smcf_up_ObjMap_app_vrange[
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>
	and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute
	]
	)
	show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (rule assms)
	fix i assume "i \<in>\<^sub>\<circ> I"
	then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2))
	show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
	by (rule cf_is_semifunctor)
	qed

	lemma cf_up_ArrMap_vrange:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	shows "\<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	proof
	(
	rule smcf_up_ArrMap_vrange[
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>
	and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute
	]
	)
	fix i assume "i \<in>\<^sub>\<circ> I"
	then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms)
	show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
	by (rule cf_is_semifunctor)
	qed

	lemma cf_up_ArrMap_app_vrange:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	shows " \<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
	proof
	(
	rule smcf_up_ArrMap_app_vrange
	[
	where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>
	and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute
	]
	)
	fix i assume "i \<in>\<^sub>\<circ> I"
	then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2))
	show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
	by (rule cf_is_semifunctor)
	qed (rule assms)

	end

	context pcategory
	begin

	interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
	by (rule pcat_psemicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	pcat_smcf_comp_smcf_proj_smcf_up = psmc.psmc_Comp_smcf_proj_smcf_up
	and pcat_smcf_up_eq_smcf_proj = psmc.psmc_smcf_up_eq_smcf_proj

	end


	subsubsection\<open>Category product universal property functor is a functor\<close>

	lemma (in pcategory) pcat_cf_up_is_functor:
	assumes "category \<alpha> \<CC>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	shows "cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	proof-
	interpret \<CC>: category \<alpha> \<CC> by (simp add: assms(1))
	interpret \<AA>: category \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> by (rule pcat_category_cat_prod)
	show ?thesis
	proof(intro is_functorI)
	show "vfsequence (cf_up I \<AA> \<CC> \<phi>)" unfolding cf_up_def by simp
	show "vcard (cf_up I \<AA> \<CC> \<phi>) = 4\<^sub>\<nat>"
	unfolding cf_up_def by (simp add: nat_omega_simps)
	show "cf_smcf (cf_up I \<AA> \<CC> \<phi>) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	unfolding slicing_commute[symmetric]
	by (rule psemicategory.psmc_smcf_up_is_semifunctor)
	(
	auto simp:
	assms(2)
	pcat_psemicategory
	is_functor.cf_is_semifunctor
	slicing_intros
	)
	show "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	proof(rule cat_prod_Arr_cong)
	from that is_arrD(1) have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by (auto intro: cat_cs_intros)
	from CId_c cf_up_ArrMap_vrange[OF assms(2), simplified]
	show "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	unfolding cf_up_components by force
	have cf_up_\<phi>_c: "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components
	proof(intro vproductI ballI)
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (simp add: prems assms(2))
	from that show "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>"
	unfolding cf_up_ObjMap_app_component[OF that prems]
	by (auto intro: cat_cs_intros)
	qed (simp_all add: cf_up_ObjMap_app that cf_up_ObjMap_app[OF that])
	from \<AA>.cat_CId_is_arr[OF this] show
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
	by auto
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (simp add: prems assms(2))
	from cf_up_\<phi>_c prems show
	"cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>i\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>i\<rparr>"
	unfolding cf_up_ArrMap_app_component[OF CId_c prems] cat_prod_components
	by
	(
	simp add:
	that cf_up_ObjMap_app_component[OF that prems] \<phi>.cf_ObjMap_CId
	)
	qed
	qed (auto simp: cf_up_components cat_cs_intros)
	qed


	subsubsection\<open>Further properties\<close>

	lemma (in pcategory) pcat_Comp_cf_proj_cf_up:
	assumes "category \<alpha> \<CC>"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	and "i \<in>\<^sub>\<circ> I"
	shows "\<phi> i = \<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F (cf_up I \<AA> \<CC> \<phi>)"
	proof-
	interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2)[OF assms(3)])
	interpret \<pi>: is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>\<AA> i\<close> \<open>\<pi>\<^sub>C I \<AA> i\<close>
	by (simp add: assms(3) pcat_cf_proj_is_functor)
	interpret up: is_functor \<alpha> \<CC> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>cf_up I \<AA> \<CC> \<phi>\<close>
	by (simp add: assms(2) \<phi>.HomDom.category_axioms pcat_cf_up_is_functor)
	show ?thesis
	proof(rule cf_smcf_eqI)
	show "\<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	by (auto intro: cat_cs_intros)
	from assms show "cf_smcf (\<phi> i) = cf_smcf (\<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F cf_up I \<AA> \<CC> \<phi>)"
	unfolding slicing_simps slicing_commute[symmetric]
	by
	(
	intro pcat_smcf_comp_smcf_proj_smcf_up[
	where \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>, unfolded slicing_commute[symmetric]
	]
	)
	(auto simp: is_functor.cf_is_semifunctor)
	qed (auto intro: cat_cs_intros)
	qed

	lemma (in pcategory) pcat_cf_up_eq_cf_proj:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i = \<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F \<FF>"
	shows "cf_up I \<AA> \<CC> \<phi> = \<FF>"
	proof(rule cf_smcf_eqI)
	interpret \<FF>: is_functor \<alpha> \<CC> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<FF> by (rule assms(1))
	show "cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
	proof(rule pcat_cf_up_is_functor)
	fix i assume prems: "i \<in>\<^sub>\<circ> I"
	then interpret \<pi>: is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>\<AA> i\<close> \<open>\<pi>\<^sub>C I \<AA> i\<close>
	by (rule pcat_cf_proj_is_functor)
	show "\<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
	unfolding assms(2)[OF prems] by (auto intro: cat_cs_intros)
	qed (auto intro: cat_cs_intros)
	show "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" by (rule assms(1))
	from assms show "cf_smcf (cf_up I \<AA> \<CC> \<phi>) = cf_smcf \<FF>"
	unfolding slicing_commute[symmetric]
	by (intro pcat_smcf_up_eq_smcf_proj) (auto simp: slicing_commute)
	qed simp_all



	subsection\<open>Prodfunctor with respect to a fixed argument\<close>

	text\<open>
	A prodfunctor is a functor whose domain is a product category.
	It is a generalization of the concept of the bifunctor,
	as presented in Chapter II-3 in \cite{mac_lane_categories_2010}.
	\<close>

	definition prodfunctor_proj :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "prodfunctor_proj \<SS> I \<AA> \<DD> J c =
	[
	(\<lambda>b\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>),
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>),
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i),
	\<DD>
	]\<^sub>\<circ>"

	syntax "_PPRODFUNCTOR_PROJ" :: "V \<Rightarrow> pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_\<^bsub>(3\<Prod>\<^sub>C_\<in>\<^sub>\<circ>_-\<^sub>\<circ>_./_),_\<^esub>/'(/-,_/'))\<close> [51, 51, 51, 51, 51, 51, 51] 51)
	translations "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I-\<^sub>\<circ>J. \<AA>,\<DD>\<^esub>(-,c)" \<rightleftharpoons>
	"CONST prodfunctor_proj \<SS> I (\<lambda>i. \<AA>) \<DD> J c"


	text\<open>Components.\<close>

	lemma prodfunctor_proj_components:
	shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>ObjMap\<rparr> =
	(\<lambda>b\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)"
	and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>ArrMap\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)"
	and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>HomDom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)"
	and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>HomCod\<rparr> = \<DD>"
	unfolding prodfunctor_proj_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda prodfunctor_proj_components(1)
	\|vsv prodfunctor_proj_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain prodfunctor_proj_ObjMap_vdomain[cat_cs_simps]\|
	\|app prodfunctor_proj_ObjMap_app[cat_cs_simps]\|


	subsubsection\<open>Arrow map\<close>

	mk_VLambda prodfunctor_proj_components(2)
	\|vsv prodfunctor_proj_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain prodfunctor_proj_ArrMap_vdomain[cat_cs_simps]\|
	\|app prodfunctor_proj_ArrMap_app[cat_cs_simps]\|


	subsubsection\<open>Prodfunctor with respect to a fixed argument is a functor\<close>

	lemma (in pcategory) pcat_prodfunctor_proj_is_functor:
	assumes "\<SS> : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
	and "J \<subseteq>\<^sub>\<circ> I"
	shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c)) : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-

	interpret is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<DD> \<SS> by (rule assms(1))
	interpret \<AA>: pcategory \<alpha> J \<AA>
	using assms(3) by (intro pcat_vsubset_index_pcategory) auto
	interpret J_\<AA>: category \<alpha> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i\<close> by (rule \<AA>.pcat_category_cat_prod)
	interpret IJ: pcategory \<alpha> \<open>I -\<^sub>\<circ> J\<close> \<AA>
	using assms(3) by (intro pcat_vsubset_index_pcategory) auto
	interpret IJ_\<AA>: category \<alpha> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i\<close>
	by (rule IJ.pcat_category_cat_prod)

	let ?IJ\<AA> = \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<close>

	from assms(2) have "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. \<AA> j\<lparr>Obj\<rparr>)"
	unfolding cat_prod_components by simp
	then have "(\<Prod>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. \<AA> j\<lparr>Obj\<rparr>) \<noteq> 0" by (auto intro!: cat_cs_intros)

	show ?thesis
	proof(intro is_functorI', unfold prodfunctor_proj_components)

	show "vfsequence (prodfunctor_proj \<SS> I \<AA> \<DD> J c)"
	unfolding prodfunctor_proj_def by simp
	show "vcard (prodfunctor_proj \<SS> I \<AA> \<DD> J c) = 4\<^sub>\<nat>"
	unfolding prodfunctor_proj_def by (simp add: nat_omega_simps)

	show "\<R>\<^sub>\<circ> (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)"
	then obtain b where x_def: "x = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>" and b: "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>"
	by auto
	have "b \<union>\<^sub>\<circ> c \<in>\<^sub>\<circ> cat_prod I \<AA>\<lparr>Obj\<rparr>"
	proof(rule cat_prod_vdiff_vunion_Obj_in_Obj)
	show "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" by (rule b)
	qed (intro assms(2,3))+
	then show "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" unfolding x_def by (auto intro: cat_cs_intros)
	qed

	show is_arr:
	"(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>f\<rparr> :
	(\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub>
	(\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>b\<rparr>"
	(is \<open>?V_f: ?V_a \<mapsto>\<^bsub>\<DD>\<^esub> ?V_b\<close>)
	if "f : a \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b" for f a b
	proof-
	let ?fc = \<open>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<close>
	have "?fc : a \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> b \<union>\<^sub>\<circ> c"
	proof(rule pcat_cat_prod_vdiff_vunion_is_arr)
	show "f : a \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b" by (rule that)
	qed (auto simp: assms cat_cs_intros)
	then have "\<SS>\<lparr>ArrMap\<rparr>\<lparr>?fc\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>a \<union>\<^sub>\<circ> c\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>"
	by (auto intro: cat_cs_intros)
	moreover from that have "f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" "a \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)
	ultimately show ?thesis by simp
	qed

	show
	"(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>f\<rparr>"
	if "g : b' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> c'" and "f : a' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b'" for g b' c' f a'
	proof-
	from that have gf: "g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f : a' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> c'"
	by (auto intro: cat_cs_intros)
	from assms(2) have CId_c: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>cat_prod J \<AA>\<^esub> c"
	by (auto intro: cat_cs_intros)
	then have [simp]:
	"cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>cat_prod J \<AA>\<^esub> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> =
	cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>"
	by (auto simp: cat_cs_simps)
	from assms(3) that(1) CId_c have g_CId_c:
	"g \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : b' \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> c' \<union>\<^sub>\<circ> c"
	by (rule pcat_cat_prod_vdiff_vunion_is_arr)
	from assms(3) that(2) CId_c have f_CId_c:
	"f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : a' \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> b' \<union>\<^sub>\<circ> c"
	by (rule pcat_cat_prod_vdiff_vunion_is_arr)
	have
	"\<SS>\<lparr>ArrMap\<rparr>\<lparr>(g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f) \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>g \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>"
	unfolding
	pcat_cat_prod_vdiff_vunion_Comp[
	OF assms(3) that(1) CId_c that(2) CId_c, simplified
	]
	by (intro cf_ArrMap_Comp[OF g_CId_c f_CId_c])
	moreover from gf have "g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" by auto
	moreover from that have "g \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" "f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" by auto
	ultimately show ?thesis by simp
	qed

	show
	"(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr>\<rparr> =
	\<DD>\<lparr>CId\<rparr>\<lparr>(\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>c'\<rparr>\<rparr>"
	if "c' \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" for c'
	proof-
	have "?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> = cat_prod I \<AA>\<lparr>CId\<rparr>\<lparr>c' \<union>\<^sub>\<circ> c\<rparr>"
	unfolding pcat_cat_prod_vdiff_vunion_CId[OF assms(3) that assms(2)] ..
	moreover from assms(3) that assms(2) have "c' \<union>\<^sub>\<circ> c \<in>\<^sub>\<circ> cat_prod I \<AA>\<lparr>Obj\<rparr>"
	by (rule cat_prod_vdiff_vunion_Obj_in_Obj)
	ultimately have "\<SS>\<lparr>ArrMap\<rparr>\<lparr>?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<DD>\<lparr>CId\<rparr>\<lparr>\<SS>\<lparr>ObjMap\<rparr>\<lparr>c' \<union>\<^sub>\<circ> c\<rparr>\<rparr>"
	by (auto intro: cat_cs_intros)
	moreover from that have CId_c': "?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>"
	by (auto dest!: IJ_\<AA>.cat_CId_is_arr)
	ultimately show ?thesis by (simp add: that)
	qed

	qed (auto intro: cat_cs_intros)

	qed

	lemma (in pcategory) pcat_prodfunctor_proj_is_functor':
	assumes "\<SS> : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
	and "J \<subseteq>\<^sub>\<circ> I"
	and "\<AA>' = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)"
	and "\<BB>' = \<DD>"
	shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c)) : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1-3)
	unfolding assms(4,5)
	by (rule pcat_prodfunctor_proj_is_functor)

	lemmas [cat_cs_intros] = pcategory.pcat_prodfunctor_proj_is_functor'



	subsection\<open>Singleton category\<close>


	subsubsection\<open>Slicing\<close>

	context
	fixes \<CC> :: V
	begin

	lemmas_with [where \<CC>=\<open>cat_smc \<CC>\<close>, unfolded slicing_simps slicing_commute]:
	cat_singleton_ObjI = smc_singleton_ObjI
	and cat_singleton_ObjE = smc_singleton_ObjE
	and cat_singleton_ArrI = smc_singleton_ArrI
	and cat_singleton_ArrE = smc_singleton_ArrE

	end

	context category
	begin

	interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	cat_finite_psemicategory_cat_singleton =
	smc.smc_finite_psemicategory_smc_singleton
	and cat_singleton_is_arrI = smc.smc_singleton_is_arrI
	and cat_singleton_is_arrD = smc.smc_singleton_is_arrD
	and cat_singleton_is_arrE = smc.smc_singleton_is_arrE

	end


	subsubsection\<open>Identity\<close>

	lemma cat_singleton_CId_app:
	assumes "set {\<langle>j, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>Obj\<rparr>"
	shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>set {\<langle>j, a\<rangle>}\<rparr> = set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rangle>}"
	using assms unfolding cat_prod_components VLambda_vsingleton by simp


	subsubsection\<open>Singleton category is a category\<close>

	lemma (in category) cat_finite_pcategory_cat_singleton:
	assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "finite_pcategory \<alpha> (set {j}) (\<lambda>i. \<CC>)"
	by
	(
	auto intro:
	assms
	category_axioms
	finite_pcategory_finite_psemicategoryI
	cat_finite_psemicategory_cat_singleton
	)

	lemma (in category) cat_category_cat_singleton:
	assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
	proof-
	interpret finite_pcategory \<alpha> \<open>set {j}\<close> \<open>\<lambda>i. \<CC>\<close>
	using assms by (rule cat_finite_pcategory_cat_singleton)
	show ?thesis by (rule pcat_category_cat_prod)
	qed



	subsection\<open>Singleton functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_singleton :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cf_singleton j \<CC> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. set {\<langle>j, a\<rangle>}),
	(\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. set {\<langle>j, f\<rangle>}),
	\<CC>,
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_singleton_components:
	shows "cf_singleton j \<CC>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. set {\<langle>j, a\<rangle>})"
	and "cf_singleton j \<CC>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. set {\<langle>j, f\<rangle>})"
	and "cf_singleton j \<CC>\<lparr>HomDom\<rparr> = \<CC>"
	and "cf_singleton j \<CC>\<lparr>HomCod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
	unfolding cf_singleton_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_singleton[slicing_commute]:
	"smcf_singleton j (cat_smc \<CC>)= cf_smcf (cf_singleton j \<CC>)"
	unfolding smcf_singleton_def cf_singleton_def slicing_simps slicing_commute
	by
	(
	simp add:
	nat_omega_simps dghm_field_simps dg_field_simps cat_smc_def cf_smcf_def
	)

	context
	fixes \<CC> :: V
	begin

	lemmas_with [where \<CC>=\<open>cat_smc \<CC>\<close>, unfolded slicing_simps slicing_commute]:
	cf_singleton_ObjMap_vsv[cat_cs_intros] = smcf_singleton_ObjMap_vsv
	and cf_singleton_ObjMap_vdomain[cat_cs_simps] = smcf_singleton_ObjMap_vdomain
	and cf_singleton_ObjMap_vrange = smcf_singleton_ObjMap_vrange
	and cf_singleton_ObjMap_app[cat_prod_cs_simps] = smcf_singleton_ObjMap_app
	and cf_singleton_ArrMap_vsv[cat_cs_intros] = smcf_singleton_ArrMap_vsv
	and cf_singleton_ArrMap_vdomain[cat_cs_simps] = smcf_singleton_ArrMap_vdomain
	and cf_singleton_ArrMap_vrange = smcf_singleton_ArrMap_vrange
	and cf_singleton_ArrMap_app[cat_prod_cs_simps] = smcf_singleton_ArrMap_app

	end


	subsubsection\<open>Singleton functor is an isomorphism of categories\<close>

	lemma (in category) cat_cf_singleton_is_functor:
	assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "cf_singleton j \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
	proof(intro is_iso_functorI is_functorI)
	from assms show smcf_singleton: "cf_smcf (cf_singleton j \<CC>) :
	cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
	unfolding slicing_commute[symmetric]
	by (intro semicategory.smc_smcf_singleton_is_iso_semifunctor)
	(auto intro: smc_cs_intros slicing_intros)
	show "vfsequence (cf_singleton j \<CC>)" unfolding cf_singleton_def by simp
	show "vcard (cf_singleton j \<CC>) = 4\<^sub>\<nat>"
	unfolding cf_singleton_def by (simp add: nat_omega_simps)
	show "cf_smcf (cf_singleton j \<CC>) :
	cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
	by (intro is_iso_semifunctor.axioms(1) smcf_singleton)
	show "cf_singleton j \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>cf_singleton j \<CC>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	proof-
	from that have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c" by (auto simp: cat_cs_intros)
	have "set {\<langle>j, c\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>Obj\<rparr>"
	by (simp add: cat_singleton_ObjI that)
	with that have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>cf_singleton j \<CC>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> =
	set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rangle>}"
	by (simp add: cf_singleton_ObjMap_app cat_singleton_CId_app)
	moreover from CId_c have
	"cf_singleton j \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rangle>}"
	by (auto simp: cf_singleton_ArrMap_app cat_cs_intros)
	ultimately show ?thesis by simp
	qed
	qed
	(
	auto simp:
	cat_cs_intros assms cat_category_cat_singleton cf_singleton_components
	)



	subsection\<open>Product of two categories\<close>


	subsubsection\<open>Definition and elementary properties.\<close>


	text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cat_prod_2 :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<times>\<^sub>C\<close> 80)
	where "\<AA> \<times>\<^sub>C \<BB> \<equiv> cat_prod (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>)"


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_prod_2[slicing_commute]:
	"cat_smc \<AA> \<times>\<^sub>S\<^sub>M\<^sub>C cat_smc \<BB> = cat_smc (\<AA> \<times>\<^sub>C \<BB>)"
	unfolding cat_prod_2_def smc_prod_2_def slicing_commute[symmetric] if_distrib
	by simp

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	lemmas_with
	[
	where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>,
	unfolded slicing_simps slicing_commute,
	OF \<AA>.cat_semicategory \<BB>.cat_semicategory
	]:
	cat_prod_2_ObjI = smc_prod_2_ObjI
	and cat_prod_2_ObjI'[cat_prod_cs_intros] = smc_prod_2_ObjI'
	and cat_prod_2_ObjE = smc_prod_2_ObjE
	and cat_prod_2_ArrI = smc_prod_2_ArrI
	and cat_prod_2_ArrI'[cat_prod_cs_intros] = smc_prod_2_ArrI'
	and cat_prod_2_ArrE = smc_prod_2_ArrE
	and cat_prod_2_is_arrI = smc_prod_2_is_arrI
	and cat_prod_2_is_arrI'[cat_prod_cs_intros] = smc_prod_2_is_arrI'
	and cat_prod_2_is_arrE = smc_prod_2_is_arrE
	and cat_prod_2_Dom_vsv = smc_prod_2_Dom_vsv
	and cat_prod_2_Dom_vdomain[cat_cs_simps] = smc_prod_2_Dom_vdomain
	and cat_prod_2_Dom_app[cat_prod_cs_simps] = smc_prod_2_Dom_app
	and cat_prod_2_Dom_vrange = smc_prod_2_Dom_vrange
	and cat_prod_2_Cod_vsv = smc_prod_2_Cod_vsv
	and cat_prod_2_Cod_vdomain[cat_cs_simps] = smc_prod_2_Cod_vdomain
	and cat_prod_2_Cod_app[cat_prod_cs_simps] = smc_prod_2_Cod_app
	and cat_prod_2_Cod_vrange = smc_prod_2_Cod_vrange
	and cat_prod_2_op_cat_cat_Obj[cat_op_simps] = smc_prod_2_op_smc_smc_Obj
	and cat_prod_2_cat_op_cat_Obj[cat_op_simps] = smc_prod_2_smc_op_smc_Obj
	and cat_prod_2_op_cat_cat_Arr[cat_op_simps] = smc_prod_2_op_smc_smc_Arr
	and cat_prod_2_cat_op_cat_Arr[cat_op_simps] = smc_prod_2_smc_op_smc_Arr

	lemmas_with
	[
	where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>,
	unfolded slicing_simps slicing_commute,
	OF \<AA>.cat_semicategory \<BB>.cat_semicategory
	]:
	cat_prod_2_Comp_app[cat_prod_cs_simps] = smc_prod_2_Comp_app

	end


	subsubsection\<open>Product of two categories is a category\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	lemma finite_pcategory_cat_prod_2: "finite_pcategory \<alpha> (2\<^sub>\<nat>) (if2 \<AA> \<BB>)"
	proof(intro finite_pcategoryI pcategory_baseI)
	from Axiom_of_Infinity show z1_in_Vset: "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	show "category \<alpha> (i = 0 ? \<AA> : \<BB>)" if "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>" for i
	by (auto simp: cat_cs_intros)
	qed auto

	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemma category_cat_prod_2[cat_cs_intros]: "category \<alpha> (\<AA> \<times>\<^sub>C \<BB>)"
	unfolding cat_prod_2_def by (rule pcat_category_cat_prod)

	end


	subsubsection\<open>Identity\<close>

	lemma cat_prod_2_CId_vsv[cat_cs_intros]: "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)"
	unfolding cat_prod_2_def cat_prod_components by simp

	lemma cat_prod_2_CId_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_2_def cat_prod_components by simp

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>(\<lambda>i. if i = 0 then \<AA> else \<BB>)\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemma cat_prod_2_CId_app[cat_prod_cs_simps]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	shows "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
	proof-
	have "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> =
	(\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)"
	by
	(
	rule
	cat_prod_CId_app[
	OF assms[unfolded cat_prod_2_def], folded cat_prod_2_def
	]
	)
	also have
	"(\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>) =
	[\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI, unfold vdomain_VLambda)
	fix i assume "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> unfolding two by auto
	then show
	"(\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)\<lparr>i\<rparr> =
	[\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<lparr>i\<rparr>"
	by cases (simp_all add: two nat_omega_simps)
	qed (auto simp: two nat_omega_simps)
	finally show ?thesis by simp
	qed

	lemma cat_prod_2_CId_vrange: "\<R>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
	show "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF \<AA> \<BB>])
	from \<AA> \<BB> a b show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	unfolding ab_def by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
	qed

	end


	subsubsection\<open>Opposite product category\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	lemma op_smc_smc_prod_2[smc_op_simps]:
	"op_cat (\<AA> \<times>\<^sub>C \<BB>) = op_cat \<AA> \<times>\<^sub>C op_cat \<BB>"
	proof(rule cat_smc_eqI [of \<alpha>])
	from \<AA> \<BB> show cat_lhs: "category \<alpha> (op_cat (\<AA> \<times>\<^sub>C \<BB>))"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	)
	interpret cat_lhs: category \<alpha> \<open>op_cat (\<AA> \<times>\<^sub>C \<BB>)\<close> by (rule cat_lhs)
	from \<AA> \<BB> show cat_rhs: "category \<alpha> (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	interpret cat_rhs: category \<alpha> \<open>op_cat \<AA> \<times>\<^sub>C op_cat \<BB>\<close> by (rule cat_rhs)
	show "op_cat (\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>"
	unfolding cat_op_simps
	proof(rule vsv_eqI, unfold cat_cs_simps)
	show "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
	show "vsv ((op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
	from \<AA> \<BB> show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros
	)
	show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr>"
	if "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab
	using that unfolding cat_cs_simps
	proof-
	from that obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF \<AA> \<BB>])
	from \<AA> \<BB> a b show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr>"
	unfolding ab_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cat_prod_cs_simps
	cs_intro: cat_op_intros cat_prod_cs_intros
	)
	qed
	qed

	from \<AA> \<BB> show "cat_smc (op_cat (\<AA> \<times>\<^sub>C \<BB>)) = cat_smc (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)"
	unfolding slicing_commute[symmetric]
	by (cs_concl cs_shallow cs_simp: smc_op_simps cs_intro: slicing_intros)

	qed

	end


	subsubsection\<open>Flip\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	lemma cat_prod_2_Obj_fconverse[cat_cs_simps]:
	"((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet> = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	proof-
	interpret fbrelation \<open>((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<close>
	by (auto elim: cat_prod_2_ObjE[OF \<AA> \<BB>])
	show ?thesis
	proof(intro vsubset_antisym vsubsetI)
	fix ba assume prems: "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet>"
	then obtain a b where ba_def: "ba = [b, a]\<^sub>\<circ>" by clarsimp
	from prems[unfolded ba_def] have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" by auto
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (auto elim: cat_prod_2_ObjE[OF \<AA> \<BB>])
	with \<AA> \<BB> show "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	unfolding ba_def by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	next
	fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF \<BB> \<AA>])
	from b a show "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet>"
	unfolding ba_def by (auto simp: cat_prod_2_ObjI[OF \<AA> \<BB> a b])
	qed
	qed

	lemma cat_prod_2_Arr_fconverse[cat_cs_simps]:
	"((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet> = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	proof-
	interpret fbrelation \<open>((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<close>
	by (auto elim: cat_prod_2_ArrE[OF \<AA> \<BB>])
	show ?thesis
	proof(intro vsubset_antisym vsubsetI)
	fix ba assume prems: "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet>"
	then obtain a b where ba_def: "ba = [b, a]\<^sub>\<circ>" by clarsimp
	from prems[unfolded ba_def] have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>" by auto
	then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (auto elim: cat_prod_2_ArrE[OF \<AA> \<BB>])
	with \<AA> \<BB> show "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	unfolding ba_def
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps
	cs_intro: cat_prod_cs_intros cat_cs_intros
	)
	next
	fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	then obtain a b
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF \<BB> \<AA>])
	from b a show "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet>"
	unfolding ba_def by (auto simp: cat_prod_2_ArrI[OF \<AA> \<BB> a b])
	qed
	qed

	end



	subsection\<open>Projections for the product of two categories\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<^sub>.\<^sub>1\<close>)
	where "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> = cf_proj (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>) 0"
	definition cf_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<^sub>.\<^sub>2\<close>)
	where "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> = cf_proj (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>) (1\<^sub>\<nat>)"


	text\<open>Slicing\<close>

	lemma cf_smcf_cf_proj_fst[slicing_commute]:
	"\<pi>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>1 (cat_smc \<AA>) (cat_smc \<BB>) = cf_smcf (\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>)"
	unfolding
	cf_proj_fst_def smcf_proj_fst_def slicing_commute[symmetric] if_distrib ..

	lemma cf_smcf_cf_proj_snd[slicing_commute]:
	"\<pi>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>2 (cat_smc \<AA>) (cat_smc \<BB>) = cf_smcf (\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>)"
	unfolding
	cf_proj_snd_def smcf_proj_snd_def slicing_commute[symmetric] if_distrib ..

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	lemmas_with
	[
	where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>,
	unfolded slicing_simps slicing_commute,
	OF \<AA>.cat_semicategory \<BB>.cat_semicategory
	]:
	cf_proj_fst_ObjMap_app = smcf_proj_fst_ObjMap_app
	and cf_proj_snd_ObjMap_app = smcf_proj_snd_ObjMap_app
	and cf_proj_fst_ArrMap_app = smcf_proj_fst_ArrMap_app
	and cf_proj_snd_ArrMap_app = smcf_proj_snd_ArrMap_app

	end


	subsubsection\<open>
	Domain and codomain of a projection of a product of two categories
	\<close>

	lemma cf_proj_fst_HomDom: "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
	unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def ..

	lemma cf_proj_fst_HomCod: "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>\<lparr>HomCod\<rparr> = \<AA>"
	unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def by simp

	lemma cf_proj_snd_HomDom: "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
	unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def ..

	lemma cf_proj_snd_HomCod: "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>\<lparr>HomCod\<rparr> = \<BB>"
	unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def by simp


	subsubsection\<open>Projection of a product of two categories is a functor\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemma cf_proj_fst_is_functor:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	rule
	pcat_cf_proj_is_functor[
	where i=0, simplified, folded cf_proj_fst_def cat_prod_2_def
	]
	)

	lemma cf_proj_fst_is_functor'[cat_cs_intros]:
	assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = \<AA> \<times>\<^sub>C \<BB>" and "\<DD> = \<AA>"
	shows "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1) unfolding assms(2,3) by (rule cf_proj_fst_is_functor)

	lemma cf_proj_snd_is_functor:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	rule
	pcat_cf_proj_is_functor[
	where i=\<open>1\<^sub>\<nat>\<close>, simplified, folded cf_proj_snd_def cat_prod_2_def
	]
	)

	lemma cf_proj_snd_is_functor'[cat_cs_intros]:
	assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = \<AA> \<times>\<^sub>C \<BB>" and "\<DD> = \<BB>"
	shows "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1) unfolding assms(2,3) by (rule cf_proj_snd_is_functor)

	end



	subsection\<open>Product of three categories\<close>


	subsubsection\<open>Definition and elementary properties.\<close>

	definition cat_prod_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" ("(_ \<times>\<^sub>C\<^sub>3 _ \<times>\<^sub>C\<^sub>3 _)" [81, 81, 81] 80)
	where "\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i)"

	abbreviation cat_pow_3 :: "V \<Rightarrow> V" (\<open>_^\<^sub>C\<^sub>3\<close> [81] 80)
	where "\<CC>^\<^sub>C\<^sub>3 \<equiv> \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_prod_3[slicing_commute]:
	"cat_smc \<AA> \<times>\<^sub>S\<^sub>M\<^sub>C\<^sub>3 cat_smc \<BB> \<times>\<^sub>S\<^sub>M\<^sub>C\<^sub>3 cat_smc \<CC> = cat_smc (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)"
	unfolding cat_prod_3_def smc_prod_3_def slicing_commute[symmetric] if_distrib
	by (simp add: if_distrib[symmetric])

	context
	fixes \<alpha> \<AA> \<BB> \<CC>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
	interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)

	lemmas_with
	[
	where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close> and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute,
	OF \<AA>.cat_semicategory \<BB>.cat_semicategory \<CC>.cat_semicategory
	]:
	cat_prod_3_ObjI = smc_prod_3_ObjI
	and cat_prod_3_ObjI'[cat_prod_cs_intros] = smc_prod_3_ObjI'
	and cat_prod_3_ObjE = smc_prod_3_ObjE
	and cat_prod_3_ArrI = smc_prod_3_ArrI
	and cat_prod_3_ArrI'[cat_prod_cs_intros] = smc_prod_3_ArrI'
	and cat_prod_3_ArrE = smc_prod_3_ArrE
	and cat_prod_3_is_arrI = smc_prod_3_is_arrI
	and cat_prod_3_is_arrI'[cat_prod_cs_intros] = smc_prod_3_is_arrI'
	and cat_prod_3_is_arrE = smc_prod_3_is_arrE
	and cat_prod_3_Dom_vsv = smc_prod_3_Dom_vsv
	and cat_prod_3_Dom_vdomain[cat_cs_simps] = smc_prod_3_Dom_vdomain
	and cat_prod_3_Dom_app[cat_prod_cs_simps] = smc_prod_3_Dom_app
	and cat_prod_3_Dom_vrange = smc_prod_3_Dom_vrange
	and cat_prod_3_Cod_vsv = smc_prod_3_Cod_vsv
	and cat_prod_3_Cod_vdomain[cat_cs_simps] = smc_prod_3_Cod_vdomain
	and cat_prod_3_Cod_app[cat_prod_cs_simps] = smc_prod_3_Cod_app
	and cat_prod_3_Cod_vrange = smc_prod_3_Cod_vrange

	lemmas_with
	[
	where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close> and \<CC>=\<open>cat_smc \<CC>\<close>,
	unfolded slicing_simps slicing_commute,
	OF \<AA>.cat_semicategory \<BB>.cat_semicategory \<CC>.cat_semicategory
	]:
	cat_prod_3_Comp_app[cat_prod_cs_simps] = smc_prod_3_Comp_app

	end


	subsubsection\<open>Product of three categories is a category\<close>

	context
	fixes \<alpha> \<AA> \<BB> \<CC>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
	begin

	interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
	interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)

	lemma finite_pcategory_cat_prod_3: "finite_pcategory \<alpha> (3\<^sub>\<nat>) (if3 \<AA> \<BB> \<CC>)"
	proof(intro finite_pcategoryI pcategory_baseI)
	from Axiom_of_Infinity show z1_in_Vset: "3\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	show "category \<alpha> (if3 \<AA> \<BB> \<CC> i)" if "i \<in>\<^sub>\<circ> 3\<^sub>\<nat>" for i
	by (auto simp: cat_cs_intros)
	qed auto

	interpretation finite_pcategory \<alpha> \<open>3\<^sub>\<nat>\<close> \<open>if3 \<AA> \<BB> \<CC>\<close>
	by (intro finite_pcategory_cat_prod_3 \<AA> \<BB> \<CC>)

	lemma category_cat_prod_3[cat_cs_intros]: "category \<alpha> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)"
	unfolding cat_prod_3_def by (rule pcat_category_cat_prod)

	end


	subsubsection\<open>Identity\<close>

	lemma cat_prod_3_CId_vsv[cat_cs_intros]: "vsv ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>)"
	unfolding cat_prod_3_def cat_prod_components by simp

	lemma cat_prod_3_CId_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>) = (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_3_def cat_prod_components by simp

	context
	fixes \<alpha> \<AA> \<BB> \<CC>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
	interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)

	interpretation finite_pcategory \<alpha> \<open>3\<^sub>\<nat>\<close> \<open>if3 \<AA> \<BB> \<CC>\<close>
	by (intro finite_pcategory_cat_prod_3 \<AA> \<BB> \<CC>)

	lemma cat_prod_3_CId_app[cat_prod_cs_simps]:
	assumes "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	shows "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>a, b, c\<rparr>\<^sub>\<bullet> = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>"
	proof-
	have "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>a, b, c\<rparr>\<^sub>\<bullet> =
	(\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)"
	by
	(
	rule
	cat_prod_CId_app[
	OF assms[unfolded cat_prod_3_def], folded cat_prod_3_def
	]
	)
	also have
	"(\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>) = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI, unfold vdomain_VLambda)
	fix i assume "i \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> unfolding three by auto
	then show
	"(\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. (if3 \<AA> \<BB> \<CC> i)\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)\<lparr>i\<rparr> =
	[\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>\<lparr>i\<rparr>"
	by cases (simp_all add: three nat_omega_simps)
	qed (auto simp: three nat_omega_simps)
	finally show ?thesis by simp
	qed

	lemma cat_prod_3_CId_vrange:
	"\<R>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
	show "vsv ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>)" by (rule cat_prod_3_CId_vsv)
	fix abc assume "abc \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	then obtain a b c where abc_def: "abc = [a, b, c]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (elim cat_prod_3_ObjE[OF \<AA> \<BB> \<CC>])
	from \<AA> \<BB> \<CC> a b c show "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>abc\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	unfolding abc_def
	by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
	qed

	end



	subsection\<open>
	Conversion of a product of three categories to products of two categories
	\<close>

	definition cf_cat_prod_21_of_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> =
	[
	(\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [[A\<lparr>0\<rparr>, A\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
	(\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [[F\<lparr>0\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
	\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>,
	(\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>
	]\<^sub>\<circ>"

	definition cf_cat_prod_12_of_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> =
	[
	(\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>),
	(\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [F\<lparr>0\<rparr>, [F\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>),
	\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>,
	\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_cat_prod_21_of_3_components:
	shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr> =
	(\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [[A\<lparr>0\<rparr>, A\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
	and "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr> =
	(\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [[F\<lparr>0\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
	and [cat_cs_simps]: "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
	and [cat_cs_simps]: "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>HomCod\<rparr> = (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
	unfolding cf_cat_prod_21_of_3_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	lemma cf_cat_prod_12_of_3_components:
	shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr> =
	(\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
	and "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr> =
	(\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [F\<lparr>0\<rparr>, [F\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
	and [cat_cs_simps]: "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
	and [cat_cs_simps]: "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>HomCod\<rparr> = \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
	unfolding cf_cat_prod_12_of_3_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object\<close>

	mk_VLambda cf_cat_prod_21_of_3_components(1)
	\|vsv cf_cat_prod_21_of_3_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain cf_cat_prod_21_of_3_ObjMap_vdomain[cat_cs_simps]\|
	\|app cf_cat_prod_21_of_3_ObjMap_app'\|

	mk_VLambda cf_cat_prod_12_of_3_components(1)
	\|vsv cf_cat_prod_12_of_3_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain cf_cat_prod_12_of_3_ObjMap_vdomain[cat_cs_simps]\|
	\|app cf_cat_prod_12_of_3_ObjMap_app'\|

	lemma cf_cat_prod_21_of_3_ObjMap_app[cat_cs_simps]:
	assumes "A = [a, b, c]\<^sub>\<circ>" and "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [[a, b]\<^sub>\<circ>, c]\<^sub>\<circ>"
	using assms(2)
	unfolding assms(1)
	by (simp add: cf_cat_prod_21_of_3_ObjMap_app' nat_omega_simps)

	lemma cf_cat_prod_12_of_3_ObjMap_app[cat_cs_simps]:
	assumes "A = [a, b, c]\<^sub>\<circ>" and "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a, [b, c]\<^sub>\<circ>]\<^sub>\<circ>"
	using assms(2)
	unfolding assms(1)
	by (simp add: cf_cat_prod_12_of_3_ObjMap_app' nat_omega_simps)

	lemma cf_cat_prod_21_of_3_ObjMap_vrange:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
	shows "\<R>\<^sub>\<circ> (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
	show ?thesis
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_21_of_3_ObjMap_vdomain)
	fix A assume prems: "A \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	then show "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	qed

	lemma cf_cat_prod_12_of_3_ObjMap_vrange:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
	shows "\<R>\<^sub>\<circ> (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
	show ?thesis
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_12_of_3_ObjMap_vdomain)
	fix A assume prems: "A \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	then show "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
	by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	qed


	subsubsection\<open>Arrow\<close>

	mk_VLambda cf_cat_prod_21_of_3_components(2)
	\|vsv cf_cat_prod_21_of_3_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain cf_cat_prod_21_of_3_ArrMap_vdomain[cat_cs_simps]\|
	\|app cf_cat_prod_21_of_3_ArrMap_app'\|

	mk_VLambda cf_cat_prod_12_of_3_components(2)
	\|vsv cf_cat_prod_12_of_3_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain cf_cat_prod_12_of_3_ArrMap_vdomain[cat_cs_simps]\|
	\|app cf_cat_prod_12_of_3_ArrMap_app'\|

	lemma cf_cat_prod_21_of_3_ArrMap_app[cat_cs_simps]:
	assumes "F = [h, g, f]\<^sub>\<circ>" and "[h, g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = [[h, g]\<^sub>\<circ>, f]\<^sub>\<circ>"
	using assms(2) unfolding assms(1)
	by (simp add: cf_cat_prod_21_of_3_ArrMap_app' nat_omega_simps)

	lemma cf_cat_prod_12_of_3_ArrMap_app[cat_cs_simps]:
	assumes "F = [h, g, f]\<^sub>\<circ>" and "[h, g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = [h, [g, f]\<^sub>\<circ>]\<^sub>\<circ>"
	using assms(2)
	unfolding assms(1)
	by (simp add: cf_cat_prod_12_of_3_ArrMap_app' nat_omega_simps)


	subsubsection\<open>
	Conversion of a product of three categories to products
	of two categories is a functor
	\<close>

	lemma cf_cat_prod_21_of_3_is_functor:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
	shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> : \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))

	show ?thesis
	proof(rule is_functorI')
	show "vfsequence (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>)"
	unfolding cf_cat_prod_21_of_3_def by auto
	show "vcard (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>) = 4\<^sub>\<nat>"
	unfolding cf_cat_prod_21_of_3_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by (rule cf_cat_prod_21_of_3_ObjMap_vrange[OF assms])
	show
	"cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
	cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>(\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>\<^esub>
	cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
	for A B F
	using that
	by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	show
	"cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> F\<rparr> =
	cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>(\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>\<^esub>
	cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
	for B C G A F
	proof-
	from that(2) obtain f f' f'' a a' a'' b b' b''
	where F_def: "F = [f, f', f'']\<^sub>\<circ>"
	and A_def: "A = [a, a', a'']\<^sub>\<circ>"
	and B_def: "B = [b, b', b'']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and f': "f' : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f'': "f'' : a'' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
	by (elim cat_prod_3_is_arrE[OF assms])
	with that(1) obtain g g' g'' c c' c''
	where G_def: "G = [g, g', g'']\<^sub>\<circ>"
	and C_def: "C = [c, c', c'']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	and g'': "g'' : b'' \<mapsto>\<^bsub>\<CC>\<^esub> c''"
	by (auto elim: cat_prod_3_is_arrE[OF assms])
	from that f f' f'' g g' g'' show ?thesis
	unfolding F_def A_def B_def G_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show
	"cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
	((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>" for C
	using that
	by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma cf_cat_prod_21_of_3_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<AA>' = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
	and "\<BB>' = (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
	shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_21_of_3_is_functor)

	lemma cf_cat_prod_12_of_3_is_functor:
	assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
	shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> : \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))

	show ?thesis
	proof(rule is_functorI')
	show "vfsequence (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>)"
	unfolding cf_cat_prod_12_of_3_def by auto
	show "vcard (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>) = 4\<^sub>\<nat>"
	unfolding cf_cat_prod_12_of_3_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
	by (rule cf_cat_prod_12_of_3_ObjMap_vrange[OF assms])
	show
	"cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
	cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)\<^esub>
	cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
	for A B F
	using that
	by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	show
	"cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> F\<rparr> =
	cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)\<^esub>
	cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	if "G : B \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
	for B C G A F
	proof-
	from that(2) obtain f f' f'' a a' a'' b b' b''
	where F_def: "F = [f, f', f'']\<^sub>\<circ>"
	and A_def: "A = [a, a', a'']\<^sub>\<circ>"
	and B_def: "B = [b, b', b'']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and f': "f' : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f'': "f'' : a'' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
	by (elim cat_prod_3_is_arrE[OF assms])
	with that(1) obtain g g' g'' c c' c''
	where G_def: "G = [g, g', g'']\<^sub>\<circ>"
	and C_def: "C = [c, c', c'']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<BB>\<^esub> c'"
	and g'': "g'' : b'' \<mapsto>\<^bsub>\<CC>\<^esub> c''"
	by (auto elim: cat_prod_3_is_arrE[OF assms])
	from that f f' f'' g g' g'' show ?thesis
	unfolding F_def A_def B_def G_def C_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show
	"cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
	(\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>CId\<rparr>\<lparr>cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>" for C
	using that
	by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma cf_cat_prod_12_of_3_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<AA>' = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
	and "\<BB>' = \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
	shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_12_of_3_is_functor)



	subsection\<open>Bifunctors\<close>

	text\<open>
	A bifunctor is defined as a functor from a product of two categories
	to a category (see Chapter II-3 in \cite{mac_lane_categories_2010}).
	This subsection exposes the elementary properties of the projections of the
	bifunctors established by fixing an argument in a functor (see Chapter II-3
	in \cite{mac_lane_categories_2010} for further information).
	\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	definition bifunctor_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_\<^bsub>_,_\<^esub>/'(/-,_/')/\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
	where "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F =
	(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat> -\<^sub>\<circ> set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>),\<SS>\<lparr>HomCod\<rparr>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})) \<circ>\<^sub>C\<^sub>F
	cf_singleton 0 \<AA>"

	definition bifunctor_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_\<^bsub>_,_\<^esub>/'(/_,-/')/\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
	where "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F =
	(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat> -\<^sub>\<circ> set {0}. (i = 0 ? \<AA> : \<BB>),\<SS>\<lparr>HomCod\<rparr>\<^esub>(-,set {\<langle>0, a\<rangle>})) \<circ>\<^sub>C\<^sub>F
	cf_singleton (1\<^sub>\<nat>) \<BB>"

	abbreviation bcf_ObjMap_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl "\<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<index>" 55)
	where "a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> b \<equiv> \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	abbreviation bcf_ArrMap_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl "\<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<index>" 55)
	where "g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f \<equiv> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"


	text\<open>Elementary properties.\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemma cat_singleton_qm_fst_def[simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>)) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)"
	proof(rule cat_eqI[of \<alpha>])
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Obj\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
	show [simp]: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Arr\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Arr\<rparr>"
	unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
	show [simp]: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Dom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Dom\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	show [simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Cod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Cod\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	have [simp]:
	"f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>)\<^esub> b \<longleftrightarrow>
	f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>\<^esub> b"
	for f a b
	unfolding is_arr_def by simp
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>"
	proof(rule vsv_eqI)
	show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)"
	unfolding cat_prod_components by simp
	show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>)"
	unfolding cat_prod_components by simp
	show "\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>) =
	\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>)"
	by (simp add: composable_arrs_def cat_cs_simps)
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>\<lparr>gf\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>\<lparr>gf\<rparr>"
	if "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)" for gf
	proof-
	from that have "gf \<in>\<^sub>\<circ> composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))"
	by (simp add: cat_cs_simps)
	then obtain g f a b c where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<^esub> b"
	by clarsimp
	then have g': "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<^esub> c"
	and f': "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<^esub> b"
	by simp_all
	show ?thesis
	unfolding gf_def
	unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
	by (subst (1 2) VLambda_vsingleton_def) simp
	qed
	qed
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>CId\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>CId\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	qed
	(
	simp_all add:
	\<AA>.cat_category_cat_singleton
	pcategory.pcat_category_cat_prod
	pcat_vsubset_index_pcategory
	vsubset_vsingleton_leftI
	)

	lemma cat_singleton_qm_snd_def[simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>)) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)"
	proof(rule cat_eqI[of \<alpha>])
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Obj\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
	show [simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Arr\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Arr\<rparr>"
	unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
	show [simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Dom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Dom\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	show [simp]:
	"(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Cod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Cod\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	have [simp]: "f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>)\<^esub> b \<longleftrightarrow>
	f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>\<^esub> b"
	for f a b
	unfolding is_arr_def by simp
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>"
	proof(rule vsv_eqI)
	show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)"
	unfolding cat_prod_components by simp
	show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>)"
	unfolding cat_prod_components by simp
	show "\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>) =
	\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>)"
	by (simp add: composable_arrs_def cat_cs_simps)
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>\<lparr>gf\<rparr> =
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>\<lparr>gf\<rparr>"
	if "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)" for gf
	proof-
	from that have "gf \<in>\<^sub>\<circ> composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))"
	by (simp add: cat_cs_simps)
	then obtain g f a b c where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<^esub> b"
	by clarsimp
	then have g': "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<^esub> c"
	and f': "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<^esub> b"
	by simp_all
	show ?thesis
	unfolding gf_def
	unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
	by (subst (1 2) VLambda_vsingleton_def) simp
	qed
	qed
	show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>CId\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>CId\<rparr>"
	unfolding cat_prod_components
	by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
	qed
	(
	simp_all add:
	\<BB>.cat_category_cat_singleton
	pcategory.pcat_category_cat_prod
	pcat_vsubset_index_pcategory
	vsubset_vsingleton_leftI
	)

	end


	subsubsection\<open>Object map\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
	cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

	lemma bifunctor_proj_fst_ObjMap_app[cat_cs_simps]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	proof-

	let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
	let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})\<close>
	let ?cfs = \<open>cf_singleton 0 \<AA>\<close>

	from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (all\<open>elim cat_prod_2_ObjE[OF \<AA> \<BB>]\<close>) auto

	from a have za: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
	by (intro cat_singleton_ObjI[where a=a]) simp
	have [simp]: "vinsert \<langle>0, a\<rangle> (set {\<langle>1\<^sub>\<nat>, b\<rangle>}) = [a, b]\<^sub>\<circ>"
	using ord_of_nat_succ_vempty unfolding vcons_def
	by (simp add: vinsert_vempty insert_commute vinsert_vsingleton)

	have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (?\<SS>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ObjMap\<rparr>)\<lparr>a\<rparr>"
	unfolding bifunctor_proj_fst_def dghm_comp_components by simp
	also have "\<dots> = ?\<SS>\<lparr>ObjMap\<rparr>\<lparr>?cfs\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by (rule vsv_vcomp_at)
	(
	simp_all add:
	two a za
	cf_singleton_components
	prodfunctor_proj_components
	cf_singleton_ObjMap_app

	)
	also from za have "\<dots> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	unfolding two cf_singleton_ObjMap_app[OF a] prodfunctor_proj_components
	by simp
	finally show ?thesis by simp

	qed

	lemma bifunctor_proj_snd_ObjMap_app[cat_cs_simps]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	proof-

	let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
	let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>})\<close>
	let ?cfs = \<open>cf_singleton (1\<^sub>\<nat>) \<BB>\<close>

	from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (all\<open>elim cat_prod_2_ObjE[OF \<AA> \<BB>]\<close>) auto
	from a have za: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
	by (intro cat_singleton_ObjI[where a=a]) simp
	from b have ob: "set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
	by (intro cat_singleton_ObjI[where a=b]) simp
	have[simp]: "vinsert \<langle>1\<^sub>\<nat>, b\<rangle> (set {\<langle>0, a\<rangle>}) = [a, b]\<^sub>\<circ>"
	using ord_of_nat_succ_vempty unfolding vcons_def
	by (simp add: vinsert_vempty)

	have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = (?\<SS>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ObjMap\<rparr>)\<lparr>b\<rparr>"
	unfolding bifunctor_proj_snd_def dghm_comp_components by simp
	also have "\<dots> = ?\<SS>\<lparr>ObjMap\<rparr>\<lparr>?cfs\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by (rule vsv_vcomp_at)
	(
	simp_all add:
	two
	cf_singleton_components
	prodfunctor_proj_components
	cf_singleton_ObjMap_app
	ob b
	)
	also from ob have "\<dots> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	unfolding two cf_singleton_ObjMap_app[OF b] prodfunctor_proj_components
	by simp
	finally show ?thesis by simp

	qed

	end


	subsubsection\<open>Arrow map\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
	cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

	lemma bifunctor_proj_fst_ArrMap_app[cat_cs_simps]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	proof-

	let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
	let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})\<close>
	let ?cfs = \<open>cf_singleton 0 \<AA>\<close>

	from assms(1) have "\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>\<BB>\<^esub> b" by (auto intro: cat_cs_intros)
	then have CId_b: "\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto

	from assms(2) have zf: "set {\<langle>0, f\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Arr\<rparr>"
	by (intro cat_singleton_ArrI[where a=f]) simp
	from assms(1) have ob: "set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
	by (intro cat_singleton_ObjI[where a=b]) simp
	have [simp]: "vinsert \<langle>0, f\<rangle> (set {\<langle>1\<^sub>\<nat>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rangle>}) = [f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
	using ord_of_nat_succ_vempty unfolding vcons_def
	by (simp add: insert_commute ord_of_nat_vone vinsert_vempty vinsert_vsingleton)

	have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = (?\<SS>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ArrMap\<rparr>)\<lparr>f\<rparr>"
	unfolding bifunctor_proj_fst_def dghm_comp_components by simp
	also have "\<dots> = ?\<SS>\<lparr>ArrMap\<rparr>\<lparr>?cfs\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	by (rule vsv_vcomp_at)
	(
	simp_all add:
	two
	assms(2)
	cf_singleton_components
	prodfunctor_proj_components
	cf_singleton_ArrMap_app
	zf
	)
	also from assms(1) zf have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components
	by (simp add: two cat_singleton_CId_app[OF ob])
	finally show ?thesis by simp

	qed

	lemma bifunctor_proj_snd_ArrMap_app[cat_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "g \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g\<rparr>\<^sub>\<bullet>"
	proof-

	let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
	let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>})\<close>
	let ?cfs = \<open>cf_singleton (1\<^sub>\<nat>) \<BB>\<close>

	from assms(1) have "\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> a" by (auto intro: cat_cs_intros)
	then have CId_a: "\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" by auto

	from assms(2) have og: "set {\<langle>1\<^sub>\<nat>, g\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Arr\<rparr>"
	by (intro cat_singleton_ArrI[where a=g]) simp
	from assms(1) have ob: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
	by (intro cat_singleton_ObjI[where a=a]) simp
	have [simp]: "vinsert \<langle>1\<^sub>\<nat>, g\<rangle> (set {\<langle>0, \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rangle>}) = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g]\<^sub>\<circ>"
	using ord_of_nat_succ_vempty unfolding vcons_def
	by (simp add: vinsert_vempty)

	have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = (?\<SS>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ArrMap\<rparr>)\<lparr>g\<rparr>"
	unfolding two bifunctor_proj_snd_def dghm_comp_components by simp
	also have "\<dots> = ?\<SS>\<lparr>ArrMap\<rparr>\<lparr>?cfs\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>"
	by (rule vsv_vcomp_at)
	(
	simp_all add:
	two
	assms(2)
	cf_singleton_components
	prodfunctor_proj_components
	cf_singleton_ArrMap_app
	og
	)
	also from assms(1) og have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g\<rparr>\<^sub>\<bullet>"
	unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components
	by (simp add: two cat_singleton_CId_app[OF ob])
	finally show ?thesis by simp

	qed

	end


	subsubsection\<open>Bifunctor projections are functors\<close>

	context
	fixes \<alpha> \<AA> \<BB>
	assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
	begin

	interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
	interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)

	interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
	by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)

	lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
	cat_singleton_qm_fst_def and cat_singleton_qm_snd_def

	lemma bifunctor_proj_fst_is_functor:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-

	interpret \<SS>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<DD> \<SS> by (rule assms(1))

	show ?thesis
	unfolding bifunctor_proj_fst_def
	proof
	(
	intro cf_comp_is_functorI[where \<BB>=\<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<close>],
	unfold \<SS>.cf_HomCod
	)
	from assms(2) have zb:
	"set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. if j = 0 then \<AA> else \<BB>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
	have o_zo: "set {1\<^sub>\<nat>} \<subseteq>\<^sub>\<circ> 2\<^sub>\<nat>" by clarsimp
	from pcat_prodfunctor_proj_is_functor[
	folded cat_prod_2_def, where J=\<open>set {1\<^sub>\<nat>}\<close>, OF assms(1) zb o_zo
	]
	show "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>}) :
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	unfolding two by simp
	from category.cat_cf_singleton_is_functor[OF \<AA>.category_axioms, of 0] show
	"cf_singleton 0 \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)"
	by force
	qed

	qed

	lemma bifunctor_proj_fst_is_functor'[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = \<AA>"
	shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_fst_is_functor)

	lemma bifunctor_proj_fst_ObjMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_fst_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ObjMap_vsv)
	qed

	lemma bifunctor_proj_fst_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_fst_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ObjMap_vdomain)
	qed

	lemma bifunctor_proj_fst_ArrMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_fst_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ArrMap_vsv)
	qed

	lemma bifunctor_proj_fst_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_fst_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ArrMap_vdomain)
	qed

	lemma bifunctor_proj_snd_is_functor:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-

	interpret \<SS>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<DD> \<SS> by (rule assms(1))

	show ?thesis
	unfolding bifunctor_proj_snd_def
	proof
	(
	intro cf_comp_is_functorI[where \<BB>=\<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<close>],
	unfold \<SS>.cf_HomCod
	)
	from assms(2) have zb:
	"set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>set {0}. if j = 0 then \<AA> else \<BB>)\<lparr>Obj\<rparr>"
	unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
	have o_zo: "set {0} \<subseteq>\<^sub>\<circ> 2\<^sub>\<nat>" by clarsimp
	from
	pcat_prodfunctor_proj_is_functor[
	folded cat_prod_2_def, where J=\<open>set {0}\<close>, OF assms(1) zb o_zo
	]
	show "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>}) :
	(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	unfolding two by simp
	from category.cat_cf_singleton_is_functor[OF \<BB>.category_axioms, of \<open>1\<^sub>\<nat>\<close>]
	show "cf_singleton (1\<^sub>\<nat>) \<BB> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)"
	by force
	qed

	qed

	lemma bifunctor_proj_snd_is_functor'[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "\<BB>' = \<BB>"
	shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_snd_is_functor)

	lemma bifunctor_proj_snd_ObjMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_snd_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ObjMap_vsv)
	qed

	lemma bifunctor_proj_snd_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_snd_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ObjMap_vdomain)
	qed

	lemma bifunctor_proj_snd_ArrMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_snd_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ArrMap_vsv)
	qed

	lemma bifunctor_proj_snd_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
	by (rule bifunctor_proj_snd_is_functor[OF assms])
	show ?thesis by (rule \<SS>.cf_ArrMap_vdomain)
	qed

	end



	subsection\<open>Bifunctor flip\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition bifunctor_flip :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "bifunctor_flip \<AA> \<BB> \<FF> =
	[fflip (\<FF>\<lparr>ObjMap\<rparr>), fflip (\<FF>\<lparr>ArrMap\<rparr>), \<BB> \<times>\<^sub>C \<AA>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"


	text\<open>Components\<close>

	lemma bifunctor_flip_components:
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr> = fflip (\<FF>\<lparr>ObjMap\<rparr>)"
	and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr> = fflip (\<FF>\<lparr>ArrMap\<rparr>)"
	and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<AA>"
	and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding bifunctor_flip_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Bifunctor flip object map\<close>

	lemma bifunctor_flip_ObjMap_vsv[cat_cs_intros]:
	"vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding bifunctor_flip_components by (rule fflip_vsv)

	lemma bifunctor_flip_ObjMap_app:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding bifunctor_flip_components assms(4,5)
	by
	(
	cs_concl cs_shallow
	cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros
	)

	lemma bifunctor_flip_ObjMap_app'[cat_cs_simps]:
	assumes "ba = [b, a]\<^sub>\<circ>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ObjMap_app)

	lemma bifunctor_flip_ObjMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	using assms
	unfolding bifunctor_flip_components
	by (cs_concl cs_shallow cs_simp: V_cs_simps cat_cs_simps)

	lemma bifunctor_flip_ObjMap_vrange[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))

	show ?thesis
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold bifunctor_flip_ObjMap_vdomain[OF assms]
	)
	fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(2,1)])
	from assms a b show
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	unfolding ba_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
	)
	qed (auto intro: cat_cs_intros)

	show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
	proof(intro vsv.vsv_vrange_vsubset, unfold \<FF>.cf_ObjMap_vdomain)
	fix ab assume prems: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	from assms a b have ba: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	from assms bifunctor_flip_ObjMap_vsv prems a b ba show
	"\<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: ab_def cat_cs_simps cs_intro: V_cs_intros
	)
	qed auto

	qed

	qed


	subsubsection\<open>Bifunctor flip arrow map\<close>

	lemma bifunctor_flip_ArrMap_vsv[cat_cs_intros]:
	"vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding bifunctor_flip_components by (rule fflip_vsv)

	lemma bifunctor_flip_ArrMap_app:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding bifunctor_flip_components
	by
	(
	cs_concl cs_shallow
	cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros
	)

	lemma bifunctor_flip_ArrMap_app'[cat_cs_simps]:
	assumes "fg = [f, g]\<^sub>\<circ>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
	using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ArrMap_app)

	lemma bifunctor_flip_ArrMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	using assms
	unfolding bifunctor_flip_components
	by (cs_concl cs_shallow cs_simp: V_cs_simps cat_cs_simps)

	lemma bifunctor_flip_ArrMap_vrange[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))

	show ?thesis
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold bifunctor_flip_ArrMap_vdomain[OF assms]
	)
	fix fg assume "fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	then obtain f g
	where fg_def: "fg = [f, g]\<^sub>\<circ>"
	and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF assms(2,1)])
	from f obtain a b where f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" by (auto intro: is_arrI)
	from g obtain a' b' where g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'" by (auto intro: is_arrI)
	from \<FF>.cf_ArrMap_vsv assms f g show
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	unfolding fg_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: V_cs_intros cat_cs_intros cat_prod_cs_intros
	)
	qed (auto intro: cat_cs_intros)

	show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
	proof(intro vsv.vsv_vrange_vsubset, unfold \<FF>.cf_ArrMap_vdomain)
	fix gf assume prems: "gf \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	then obtain g f
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF assms(1,2)])
	from assms g f have fg: "[f, g]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	from assms bifunctor_flip_ArrMap_vsv prems g f fg show
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding gf_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	qed auto

	qed

	qed


	subsubsection\<open>Bifunctor flip is a bifunctor\<close>

	lemma bifunctor_flip_is_functor:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> "
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms)

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (bifunctor_flip \<AA> \<BB> \<FF>)"
	unfolding bifunctor_flip_def by simp
	from assms(1,2) show "category \<alpha> (\<BB> \<times>\<^sub>C \<AA>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "vcard (bifunctor_flip \<AA> \<BB> \<FF>) = 4\<^sub>\<nat>"
	unfolding bifunctor_flip_def by (simp add: nat_omega_simps)
	show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)" by (auto intro: cat_cs_intros)
	show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)" by (auto intro: cat_cs_intros)
	from assms show "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms \<FF>.cf_ObjMap_vrange show
	"\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms show "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> :
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'a'\<rparr>"
	if "gf : ba \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> b'a'" for ba b'a' gf
	proof-
	from that obtain g f a b a' b'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b'a'_def: "b'a' = [b', a']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	by (elim cat_prod_2_is_arrE[OF assms(2,1)])
	from assms g f show ?thesis
	unfolding gf_def ba_def b'a'_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> ff'\<rparr> =
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
	if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> cc'" and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> bb'"
	for bb' cc' gg' aa' ff'
	proof-
	obtain g g' b b' c c'
	where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<AA>\<^esub> c'"
	by (elim cat_prod_2_is_arrE[OF assms(2,1) gg'])
	moreover obtain f f' a a' b'' b'''
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and "bb' = [b'', b''']\<^sub>\<circ>"
	and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and "f' : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'''"
	by (elim cat_prod_2_is_arrE[OF assms(2,1) ff'])
	ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"
	by (auto simp: cat_op_simps)
	from assms g g' f f' have [cat_cs_simps]:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f\<rparr>\<^sub>\<bullet> =
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>[g', g]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [f', f]\<^sub>\<circ>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_2_Comp_app cs_intro: cat_prod_cs_intros
	)
	from assms g g' f f' show
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> ff'\<rparr> =
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
	unfolding gg'_def ff'_def (slow)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_cs_simps cat_cs_simps
	cs_intro: cat_prod_cs_intros cat_cs_intros
	)
	qed
	show
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>(\<BB> \<times>\<^sub>C \<AA>)\<lparr>CId\<rparr>\<lparr>ba\<rparr>\<rparr> =
	\<CC>\<lparr>CId\<rparr>\<lparr>bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr>\<rparr>"
	if "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>" for ba
	proof-
	from that obtain b a
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
	from assms b a have [cat_cs_simps]:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_2_CId_app cs_intro: cat_prod_cs_intros
	)
	from assms b a show ?thesis
	unfolding ba_def
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_prod_cs_intros
	cs_simp: cat_prod_cs_simps cat_cs_simps
	)
	qed
	qed (auto simp: bifunctor_flip_components cat_cs_simps cat_cs_intros)

	qed

	lemma bifunctor_flip_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
	shows "bifunctor_flip \<AA> \<BB> \<FF> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1-3) unfolding assms(4) by (intro bifunctor_flip_is_functor)


	subsubsection\<open>Double-flip of a bifunctor\<close>

	lemma bifunctor_flip_flip[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>) = \<FF>"
	proof(rule cf_eqI)

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))

	from assms show
	"bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>) : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> (bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr>) =
	(\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (simp add: cat_cs_simps)
	from assms have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> (bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr>) =
	(\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	by (simp add: cat_cs_simps)

	show "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (rule cat_prod_2_ObjE[OF assms(1,2)])
	from assms a b show
	"bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	unfolding ab_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: cat_cs_intros)

	show "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (rule cat_prod_2_ArrE[OF assms(1,2)])
	from assms a b show
	"bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr>"
	unfolding ab_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: cat_cs_intros)

	qed (simp_all add: assms(3))


	subsubsection\<open>A projection of a bifunctor flip\<close>

	lemma bifunctor_flip_proj_snd[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F = \<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	proof(rule cf_eqI)

	from assms show f_\<FF>b: "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show \<FF>b: "\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show "(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr> = (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	from assms show "vsv ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
	by (intro bifunctor_proj_snd_ObjMap_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "vsv ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
	by (intro bifunctor_proj_fst_ObjMap_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show
	"(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
	(\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
	qed simp

	show
	"(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr> = (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	from assms show "vsv ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
	by (intro bifunctor_proj_snd_ArrMap_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "vsv ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
	by (intro bifunctor_proj_fst_ArrMap_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	fix f assume "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	with assms show
	"(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed simp

	qed simp_all

	lemma bifunctor_flip_proj_fst[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(-,a)\<^sub>C\<^sub>F = \<FF>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	proof-
	from assms have f_\<FF>: "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show ?thesis
	by
	(
	rule
	bifunctor_flip_proj_snd
	[
	OF assms(2,1) f_\<FF> assms(4),
	unfolded bifunctor_flip_flip[OF assms(1,2,3)],
	symmetric
	]
	)
	qed


	subsubsection\<open>A flip of a bifunctor isomorphism\<close>

	lemma bifunctor_flip_is_iso_functor:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC> "
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<FF>: is_iso_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))

	from assms have f_\<FF>: "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> "
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from f_\<FF> have ObjMap_dom:
	"\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	from f_\<FF> have ArrMap_dom:
	"\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)

	show ?thesis
	proof(intro is_iso_functorI' vsv.vsv_valeq_v11I, unfold ObjMap_dom ArrMap_dom)
	from assms show "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	fix ba b'a'
	assume prems:
	"ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	"b'a' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'a'\<rparr>"
	from prems(1) obtain b a
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(2,1)])
	from prems(2) obtain a' b'
	where b'a'_def: "b'a' = [b', a']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (rule cat_prod_2_ObjE[OF assms(2,1)])
	from prems(3) assms a b b' a' have \<FF>ab_\<FF>a'b':
	"\<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet>"
	unfolding ba_def b'a'_def
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
	from assms a b a' b' have "[a, b]\<^sub>\<circ> = [a', b']\<^sub>\<circ>"
	by
	(
	cs_concl cs_shallow
	cs_intro:
	\<FF>.ObjMap.v11_eq_iff[THEN iffD1, OF _ _ \<FF>ab_\<FF>a'b']
	cat_prod_cs_intros
	)
	then show "ba = b'a'" unfolding ba_def b'a'_def by simp
	next
	fix fg f'g' assume prems:
	"fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	"f'g' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	"bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'g'\<rparr>"
	from prems(1) obtain f g
	where fg_def: "fg = [f, g]\<^sub>\<circ>"
	and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF assms(2,1)])
	from prems(2) obtain f' g'
	where f'g'_def: "f'g' = [f', g']\<^sub>\<circ>"
	and f': "f' \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and g': "g' \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	by (rule cat_prod_2_ArrE[OF assms(2,1)])
	from prems(3) assms f g f' g' have \<FF>gf_\<FF>g'f':
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g', f'\<rparr>\<^sub>\<bullet>"
	unfolding fg_def f'g'_def
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
	from assms g f g' f' have "[g, f]\<^sub>\<circ> = [g', f']\<^sub>\<circ>"
	by
	(
	cs_concl cs_shallow
	cs_intro:
	\<FF>.ArrMap.v11_eq_iff[THEN iffD1, OF _ _ \<FF>gf_\<FF>g'f']
	cat_prod_cs_intros
	)
	then show "fg = f'g'" unfolding fg_def f'g'_def by simp
	next

	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	proof(rule vsubset_antisym)
	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold ObjMap_dom)
	fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	then obtain b a
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(2,1)])
	from assms b a show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	unfolding ba_def
	by (cs_concl cs_intro: cat_cs_intros cf_cs_intros cat_prod_cs_intros)
	qed (auto simp: cat_cs_intros)
	show "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
	proof(intro vsubsetI)
	fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from prems obtain ab
	where ab: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" and \<FF>ab: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> = c"
	by blast
	from ab obtain b a
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	show "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
	proof(intro vsv.vsv_vimageI2', unfold ObjMap_dom)
	from assms a b show "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	from assms b a prems show "c = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl cs_shallow
	cs_simp: \<FF>ab[unfolded ab_def] cat_cs_simps
	cs_intro: cf_cs_intros
	)
	qed (auto intro: cat_cs_intros)
	qed
	qed

	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	proof(rule vsubset_antisym)
	show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold ArrMap_dom)
	show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)" by (auto intro: cat_cs_intros)
	fix fg assume "fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	then obtain f g
	where fg_def: "fg = [f, g]\<^sub>\<circ>"
	and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF assms(2,1)])
	from g f obtain a b a' b'
	where f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"
	by (auto intro!: is_arrI)
	from assms f g show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: fg_def cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show "\<CC>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
	proof(intro vsubsetI)
	fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	from prems obtain ab
	where ab: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>" and \<FF>ab: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr> = c"
	by blast
	from ab obtain b a
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[OF assms(1,2)])
	show "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
	proof(intro vsv.vsv_vimageI2', unfold ArrMap_dom)
	from assms a b show "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	from assms b a prems show "c = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl cs_shallow
	cs_simp: \<FF>ab[unfolded ab_def] cat_cs_simps
	cs_intro: cat_cs_intros
	)
	qed (auto intro: cat_cs_intros)
	qed
	qed

	qed (auto intro: cat_cs_intros)

	qed



	subsection\<open>Array bifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_array :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<GG> (vpfst a)\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>),
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
	\<GG> (\<BB>\<lparr>Cod\<rparr>\<lparr>vpfst f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	\<FF> (\<CC>\<lparr>Dom\<rparr>\<lparr>vpsnd f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>
	),
	\<BB> \<times>\<^sub>C \<CC>,
	\<DD>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_array_components:
	shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<GG> (vpfst a)\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>)"
	and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
	\<GG> (\<BB>\<lparr>Cod\<rparr>\<lparr>vpfst f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	\<FF> (\<CC>\<lparr>Dom\<rparr>\<lparr>vpsnd f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>
	)"
	and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<CC>"
	and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<DD>"
	unfolding cf_array_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_array_ObjMap_vsv: "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
	unfolding cf_array_components by simp

	lemma cf_array_ObjMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	unfolding cf_array_components by simp

	lemma cf_array_ObjMap_app[cat_cs_simps]:
	assumes "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	using assms unfolding cf_array_components by (simp add: nat_omega_simps)

	lemma cf_array_ObjMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ObjMap_vdomain)
	show "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>)" by (rule cf_array_ObjMap_vsv)
	fix x assume prems: "x \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	then obtain b c where x_def: "x = [b, c]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	interpret \<GG>b: is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b\<close> by (rule assms(3)[OF b])
	from prems c show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	unfolding x_def cf_array_components
	by (auto simp: nat_omega_simps cat_cs_intros)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma cf_array_ArrMap_vsv: "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>)"
	unfolding cf_array_components by simp

	lemma cf_array_ArrMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	unfolding cf_array_components by simp

	lemma cf_array_ArrMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "g : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and "f : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	\<GG> b\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	proof-
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	from cat_prod_2_is_arrI[OF assms] have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>" by auto
	with assms show ?thesis
	unfolding cf_array_components by (simp add: nat_omega_simps cat_cs_simps)
	qed

	lemma cf_array_ArrMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and [cat_cs_simps]:
	"\<And>b c. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ArrMap_vdomain)
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	interpret \<BB>\<CC>: category \<alpha> \<open>\<BB> \<times>\<^sub>C \<CC>\<close>
	by (simp add: \<BB>.category_axioms \<CC>.category_axioms category_cat_prod_2)
	fix gf assume prems: "gf \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	then obtain bc b'c' where gf: "gf : bc \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> b'c'" by auto
	then obtain g f b c b' c'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and "bc = [b, c]\<^sub>\<circ>"
	and "b'c' = [b', c']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	by (elim cat_prod_2_is_arrE[OF assms(1,2)])
	then have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by auto
	interpret \<GG>b: is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b\<close> by (rule assms(4)[OF b])
	interpret \<FF>c: is_functor \<alpha> \<BB> \<DD> \<open>\<FF> c\<close> by (rule assms(3)[OF c])
	interpret \<GG>b': is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b'\<close> by (rule assms(4)[OF b'])
	interpret \<FF>c': is_functor \<alpha> \<BB> \<DD> \<open>\<FF> c'\<close> by (rule assms(3)[OF c'])
	from
	\<GG>b.is_functor_axioms
	\<FF>c.is_functor_axioms
	\<GG>b'.is_functor_axioms
	\<FF>c'.is_functor_axioms
	\<GG>b.HomCod.category_axioms
	g f
	have "\<GG> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	with g f prems show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	unfolding gf_def cf_array_components
	by (simp add: nat_omega_simps cat_cs_simps)
	qed (simp add: cf_array_ArrMap_vsv)


	subsubsection\<open>Array bifunctor is a bifunctor\<close>

	lemma cf_array_specification:
	\<comment>\<open>See Proposition 1 from Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>b c. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and
	"\<And>b c b' c' f g. \<lbrakk> f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'; g : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<rbrakk> \<Longrightarrow>
	\<GG> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<FF> c'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> b\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	shows cf_array_is_functor: "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and cf_array_ObjMap_app_fst: "\<And>b c. \<lbrakk> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and cf_array_ObjMap_app_snd: "\<And>b c. \<lbrakk> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	and cf_array_ArrMap_app_fst: "\<And>a b f c. \<lbrakk> f : a \<mapsto>\<^bsub>\<BB>\<^esub> b; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>\<rbrakk> \<Longrightarrow>
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	and cf_array_ArrMap_app_snd: "\<And>a b g c. \<lbrakk> g : a \<mapsto>\<^bsub>\<CC>\<^esub> b; c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, g\<rparr>\<^sub>\<bullet> = \<GG> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	proof-

	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))

	from assms(4) have [cat_cs_intros]: "\<FF> c : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<DD>'"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<BB>' = \<BB>" "\<DD>' = \<DD>" "\<alpha>' = \<alpha>" for \<alpha>' c \<BB>' \<DD>'
	using that(1) unfolding that(2-4) by (intro assms(4))
	from assms(4) have [cat_cs_intros]: "\<GG> c : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<DD>'"
	if "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" "\<CC>' = \<CC>" "\<DD>' = \<DD>" "\<alpha>' = \<alpha>" for \<alpha>' c \<CC>' \<DD>'
	using that(1) unfolding that(2-4) by (intro assms(5))

	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof(intro is_functorI')
	show "vfsequence (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>)" unfolding cf_array_def by auto
	from assms(1,2) show "category \<alpha> (\<BB> \<times>\<^sub>C \<CC>)"
	by (simp add: category_cat_prod_2)
	show "vcard (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>) = 4\<^sub>\<nat>"
	unfolding cf_array_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (rule cf_array_ObjMap_vrange) (auto simp: assms intro: cat_cs_intros)
	show cf_array_is_arrI: "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
	if ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> bb'" for aa' bb' ff'
	proof-
	obtain f f' a a' b b'
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms ff'])
	then have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a': "a' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by auto
	from f' assms(5)[OF a] a have
	"\<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
	with assms(1-3) f f' assms(4)[OF b'] show ?thesis
	unfolding ff'_def aa'_def bb'_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps assms(6)
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> ff'\<rparr> =
	cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
	if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> cc'" and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> bb'"
	for bb' cc' gg' aa' ff'
	proof-
	obtain g g' b b' c c'
	where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms gg'])
	moreover obtain f f' a a' b'' b'''
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and "bb' = [b'', b''']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'''"
	by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms ff'])
	ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'" by auto
	with g have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a': "a' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and c': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by auto
	from f' assms(5)[OF a] a have \<GG>a_f':
	"\<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
	from f' b assms(5)[OF b] have \<GG>b_f':
	"\<GG> b\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
	from f' c assms(5)[OF c] have \<GG>c_f':
	"\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
	have
	"\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>) =
	(\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>) \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	using f' f g \<GG>b_f' assms(4)[OF a'] assms(4)[OF b']
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps assms(7) cs_intro: cat_cs_intros
	)
	also have "\<dots> =
	\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	using assms(2) f f' g g' assms(4)[OF a'] assms(5)[OF c]
	by (cs_concl cs_simp: assms(6) cat_cs_simps cs_intro: cat_cs_intros)
	finally have [cat_cs_simps]:
	"\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>) =
	\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	by simp
	show ?thesis
	using
	\<GG>a_f' \<GG>c_f'
	f f'
	g g'
	assms(1,2)
	assms(4)[OF a']
	assms(4)[OF c']
	assms(5)[OF c]
	unfolding gg'_def ff'_def aa'_def bb'_def cc'_def (slow)
	by
	(
	cs_concl
	cs_simp: assms(6,7) cat_prod_cs_simps cat_cs_simps
	cs_intro: cat_prod_cs_intros cat_cs_intros
	)
	qed
	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> =
	\<DD>\<lparr>CId\<rparr>\<lparr>cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
	if "cc' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for cc'
	proof-
	from that obtain c c'
	where cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
	from assms(1,2,3) c c' assms(4)[OF c'] assms(5)[OF c] show ?thesis
	unfolding cc'_def (slow)
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps assms(6)
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	qed (auto simp: cf_array_components cat_cs_intros)

	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for b c
	using that assms(1,2,3)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps assms(6) cs_intro: cat_prod_cs_intros
	)
	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for b c
	using that assms(1,2,3)
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a b f c
	proof-
	from f have "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	from assms(5)[OF this(1)] assms(5)[OF this(2)] assms(4)[OF c] show ?thesis
	using assms(1,2,3) f c
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps assms(6) cs_intro: cat_cs_intros
	)
	qed

	show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, g\<rparr>\<^sub>\<bullet> = \<GG> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	if g: "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for a b g c
	proof-
	from g have "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	from assms(4)[OF this(1)] assms(4)[OF this(2)] assms(5)[OF c] show ?thesis
	using assms(1,2,3) g c
	by
	(
	cs_concl
	cs_simp: cat_cs_simps assms(6)[symmetric] cs_intro: cat_cs_intros
	)
	qed

	qed



	subsection\<open>Composition of a covariant bifunctor and covariant functors\<close>


	subsubsection\<open>Definition and elementary properties.\<close>

	definition cf_bcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_bcomp \<SS> \<FF> \<GG> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	\<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
	),
	\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>,
	\<SS>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_bcomp_components:
	shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	\<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
	)"
	and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
	)"
	and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
	and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_bcomp_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_bcomp_ObjMap_vsv: "vsv (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
	unfolding cf_bcomp_components by simp

	lemma cf_bcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms)
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms)
	show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
	qed

	lemma cf_bcomp_ObjMap_app[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	from assms show ?thesis
	unfolding cf_bcomp_components
	by (simp_all add: cat_cs_simps nat_omega_simps)
	qed

	lemma cf_bcomp_ObjMap_vrange:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_bcomp_ObjMap_vdomain[OF assms(1,2)]
	)
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	show "vsv (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)" by (rule cf_bcomp_ObjMap_vsv)
	fix bc assume "bc \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	with \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms obtain b c
	where bc_def: "bc = [b, c]\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated -1])
	from assms b c show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bc\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	unfolding bc_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma cf_bcomp_ArrMap_vsv: "vsv (cf_bcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding cf_bcomp_components by simp

	lemma cf_bcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
	qed

	lemma cf_bcomp_ArrMap_app[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>\<^sub>\<bullet>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	from assms show ?thesis
	unfolding cf_bcomp_components by (simp_all add: nat_omega_simps cat_cs_simps)
	qed

	lemma cf_bcomp_ArrMap_vrange:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_bcomp_ArrMap_vdomain[OF assms(1,2)])
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	fix gf assume "gf \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	with \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms obtain g f
	where gf_def: "gf = [g, f]\<^sub>\<circ>" and g: "g \<in>\<^sub>\<circ> \<BB>'\<lparr>Arr\<rparr>" and f: "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[rotated -1])
	from g obtain a b where g: "g : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" by auto
	from f obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
	from assms g f show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	unfolding gf_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (simp add: cf_bcomp_ArrMap_vsv)


	subsubsection\<open>
	Composition of a covariant bifunctor and
	covariant functors is a functor
	\<close>

	lemma cf_bcomp_is_functor:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_bcomp \<SS> \<FF> \<GG> : \<BB>' \<times>\<^sub>C \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	interpret \<SS>: is_functor \<alpha> \<open>\<BB> \<times>\<^sub>C \<CC>\<close> \<DD> \<SS> by (rule assms(3))

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (cf_bcomp \<SS> \<FF> \<GG>)" unfolding cf_bcomp_def by simp
	show "category \<alpha> (\<BB>' \<times>\<^sub>C \<CC>')"
	by
	(
	simp add:
	\<FF>.HomDom.category_axioms
	\<GG>.HomDom.category_axioms
	category_cat_prod_2
	)
	show "vcard (cf_bcomp \<SS> \<FF> \<GG>) = 4\<^sub>\<nat>"
	unfolding cf_bcomp_def by (simp add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (rule cf_bcomp_ObjMap_vrange)
	show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
	cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
	if ff': "ff' : aa' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'" for aa' bb' ff'
	proof-
	obtain f f' a a' b b'
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b"
	and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'"
	by
	(
	elim
	cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms ff'
	]
	)
	from assms f f' show ?thesis
	unfolding ff'_def aa'_def bb'_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> ff'\<rparr> =
	cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
	if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> cc'"
	and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'"
	for bb' cc' gg' aa' ff'
	proof-
	obtain g g' b b' c c'
	where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>'\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<CC>'\<^esub> c'"
	by
	(
	elim cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms gg'
	]
	)
	moreover obtain f f' a a' b'' b'''
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and "bb' = [b'', b''']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b''"
	and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'''"
	by
	(
	elim cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms ff'
	]
	)
	ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
	from assms f f' g g' have [cat_cs_simps]:
	"[\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ> =
	[\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from assms f f' g g' show ?thesis
	unfolding gg'_def ff'_def aa'_def bb'_def cc'_def
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show
	"cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(\<BB>' \<times>\<^sub>C \<CC>')\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> =
	\<DD>\<lparr>CId\<rparr>\<lparr>cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
	if "cc' \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>" for cc'
	proof-
	from that obtain c c'
	where cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and c: "c \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>"
	and c': "c' \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
	from assms c c' have [cat_cs_simps]:
	"[\<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>]\<^sub>\<circ> =
	(\<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from assms c c' show ?thesis
	unfolding cc'_def
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	qed (auto simp: cf_bcomp_components cat_cs_intros cat_cs_simps)

	qed

	lemma cf_bcomp_is_functor'[cat_cs_intros]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA>' = \<BB>' \<times>\<^sub>C \<CC>'"
	shows "cf_bcomp \<SS> \<FF> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_bcomp_is_functor)



	subsection\<open>Composition of a contracovariant bifunctor and covariant functors\<close>

	text\<open>
	The term \<open>contracovariant bifunctor\<close> is used to refer to a bifunctor
	that is contravariant in the first argument and covariant in the second
	argument.
	\<close>

	definition cf_cn_cov_bcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_cn_cov_bcomp \<SS> \<FF> \<GG> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	\<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
	),
	op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>,
	\<SS>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_cn_cov_bcomp_components:
	shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	\<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
	)"
	and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
	)"
	and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
	and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_cn_cov_bcomp_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_cn_cov_bcomp_ObjMap_vsv: "vsv (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
	unfolding cf_cn_cov_bcomp_components by simp

	lemma cf_cn_cov_bcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	show ?thesis
	unfolding cf_cn_cov_bcomp_components
	by (simp add: nat_omega_simps cat_cs_simps)
	qed

	lemma cf_cn_cov_bcomp_ObjMap_app[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	shows
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> =
	\<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	from assms show ?thesis
	unfolding cf_cn_cov_bcomp_components
	by (simp_all add: cat_cs_simps nat_omega_simps)
	qed

	lemma cf_cn_cov_bcomp_ObjMap_vrange:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_cn_cov_bcomp_ObjMap_vdomain[OF assms(1,2)]
	)
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	show "vsv (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
	by (rule cf_cn_cov_bcomp_ObjMap_vsv)
	fix bc assume "bc \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
	with \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms obtain b c
	where bc_def: "bc = [b, c]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated -1])
	from assms b c show "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bc\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	unfolding bc_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


	subsubsection\<open>Arrow map\<close>

	lemma cf_cn_cov_bcomp_ArrMap_vsv: "vsv (cf_cn_cov_bcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding cf_cn_cov_bcomp_components by simp

	lemma cf_cn_cov_bcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	show ?thesis unfolding cf_cn_cov_bcomp_components by (simp add: cat_cs_simps)
	qed

	lemma cf_cn_cov_bcomp_ArrMap_app[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>\<^sub>\<bullet>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	from assms show ?thesis
	unfolding cf_cn_cov_bcomp_components
	by (simp_all add: nat_omega_simps cat_cs_simps)
	qed

	lemma cf_cn_cov_bcomp_ArrMap_vrange:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_cn_cov_bcomp_ArrMap_vdomain[OF assms(1,2)]
	)
	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	fix gf assume "gf \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
	with \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms obtain g f
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Arr\<rparr>"
	and f: "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
	by (elim cat_prod_2_ArrE[rotated -1])
	from g obtain a b where g: "g : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" unfolding cat_op_simps by auto
	from f obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
	from assms g f show "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	unfolding gf_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed (rule cf_cn_cov_bcomp_ArrMap_vsv)


	subsubsection\<open>
	Composition of a contracovariant bifunctor and functors is a functor
	\<close>

	lemma cf_cn_cov_bcomp_is_functor:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG> : op_cat \<BB>' \<times>\<^sub>C \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
	interpret \<SS>: is_functor \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<DD> \<SS> by (rule assms(3))

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (cf_cn_cov_bcomp \<SS> \<FF> \<GG>)"
	unfolding cf_cn_cov_bcomp_def by simp
	show "category \<alpha> (op_cat \<BB>' \<times>\<^sub>C \<CC>')"
	by
	(
	simp add:
	\<FF>.HomDom.category_op \<GG>.HomDom.category_axioms category_cat_prod_2
	)
	show "vcard (cf_cn_cov_bcomp \<SS> \<FF> \<GG>) = 4\<^sub>\<nat>"
	unfolding cf_cn_cov_bcomp_def by (simp add: nat_omega_simps)
	from assms show "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (rule cf_cn_cov_bcomp_ObjMap_vrange)
	show
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
	cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub>
	cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
	if ff': "ff' : aa' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'" for aa' bb' ff'
	proof-
	obtain f f' a a' b b'
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b"
	and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'"
	by
	(
	elim
	cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms ff'
	]
	)
	from assms f f' show ?thesis
	unfolding ff'_def aa'_def bb'_def cat_op_simps
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed
	show
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> ff'\<rparr> =
	cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
	if gg': "gg' : bb' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> cc'"
	and ff': "ff' : aa' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'"
	for bb' cc' gg' aa' ff'
	proof-
	obtain g g' b b' c c'
	where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
	and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
	and cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> c"
	and g': "g' : b' \<mapsto>\<^bsub>\<CC>'\<^esub> c'"
	by
	(
	elim cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms gg'
	]
	)
	moreover obtain f f' a a' b'' b'''
	where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
	and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
	and "bb' = [b'', b''']\<^sub>\<circ>"
	and f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b''"
	and "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'''"
	by
	(
	elim cat_prod_2_is_arrE[
	OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms ff'
	]
	)
	ultimately have f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'"
	by auto
	from assms f f' g g' have [cat_cs_simps]:
	"[
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>,
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>
	]\<^sub>\<circ> =
	[\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>op_cat \<BB> \<times>\<^sub>C \<CC>\<^esub>
	[\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ>"
	unfolding cat_op_simps
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from assms f f' g g' show ?thesis
	unfolding gg'_def ff'_def aa'_def bb'_def cc'_def cat_op_simps
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed
	show
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> =
	\<DD>\<lparr>CId\<rparr>\<lparr>cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
	if "cc' \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>" for cc'
	proof-
	from that obtain c c'
	where cc'_def: "cc' = [c, c']\<^sub>\<circ>"
	and c: "c \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Obj\<rparr>"
	and c': "c' \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2])
	(auto intro: cat_cs_intros)
	from assms c c' have [cat_cs_simps]:
	"[\<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>]\<^sub>\<circ> =
	(op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>\<^sub>\<bullet>"
	unfolding cat_op_simps
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_prod_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from assms c c' show ?thesis
	unfolding cc'_def cat_op_simps
	by (slow)
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed
	qed (auto simp: cf_cn_cov_bcomp_components cat_cs_simps intro: cat_cs_intros)

	qed

	lemma cf_cn_cov_bcomp_is_functor'[cat_cs_intros]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA>' = op_cat \<BB>' \<times>\<^sub>C \<CC>'"
	shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_bcomp_is_functor)


	subsubsection\<open>Projection of a contracovariant bifunctor and functors\<close>

	lemma cf_cn_cov_bcomp_bifunctor_proj_snd[cat_cs_simps]:
	assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "b \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>"
	shows
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F =
	(\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>"
	proof(rule cf_eqI)
	from assms show [intro]:
	"cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	"(\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
	from assms have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<CC>'\<lparr>Obj\<rparr>"
	and ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>) = \<CC>'\<lparr>Obj\<rparr>"
	and ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<CC>'\<lparr>Arr\<rparr>"
	and ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>) = \<CC>'\<lparr>Arr\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros cs_simp: cat_cs_simps)+
	show
	"(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr> =
	((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
	with assms show
	"(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
	((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_prod_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed (auto intro: is_functor.cf_ObjMap_vsv)
	show
	"(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr> =
	((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
	then obtain a' b' where "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by (auto intro: is_arrI)
	with assms show
	"(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed (auto intro: is_functor.cf_ArrMap_vsv)
	qed simp_all



	subsection\<open>Composition of a covariant bifunctor and a covariant functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_lcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_lcomp \<CC> \<SS> \<FF> = cf_bcomp \<SS> \<FF> (cf_id \<CC>)"

	definition cf_rcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_rcomp \<BB> \<SS> \<GG> = cf_bcomp \<SS> (cf_id \<BB>) \<GG>"


	text\<open>Components.\<close>

	lemma cf_lcomp_components:
	shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<CC>"
	and "cf_lcomp \<CC> \<SS> \<FF>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_lcomp_def cf_bcomp_components dghm_id_components by simp_all

	lemma cf_rcomp_components:
	shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
	and "cf_rcomp \<BB> \<SS> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_rcomp_def cf_bcomp_components dghm_id_components by simp_all


	subsubsection\<open>Object map\<close>

	lemma cf_lcomp_ObjMap_vsv: "vsv (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding cf_lcomp_def by (rule cf_bcomp_ObjMap_vsv)

	lemma cf_rcomp_ObjMap_vsv: "vsv (cf_rcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding cf_rcomp_def by (rule cf_bcomp_ObjMap_vsv)

	lemma cf_lcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) = (\<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_rcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_lcomp_ObjMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, c\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, c\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

	lemma cf_rcomp_ObjMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b, \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

	lemma cf_lcomp_ObjMap_vrange:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_lcomp_def
	by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_rcomp_ObjMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_rcomp_def
	by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+


	subsubsection\<open>Arrow map\<close>

	lemma cf_lcomp_ArrMap_vsv: "vsv (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding cf_lcomp_def by (rule cf_bcomp_ArrMap_vsv)

	lemma cf_rcomp_ArrMap_vsv: "vsv (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>)"
	unfolding cf_rcomp_def by (rule cf_bcomp_ArrMap_vsv)

	lemma cf_lcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) = (\<AA> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_rcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_lcomp_ArrMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, g\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

	lemma cf_rcomp_ArrMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)

	lemma cf_lcomp_ArrMap_vrange:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_lcomp_def
	by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_rcomp_ArrMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_rcomp_def
	by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+


	subsubsection\<open>
	Composition of a covariant bifunctor and a covariant functor is a functor
	\<close>

	lemma cf_lcomp_is_functor:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_lcomp \<CC> \<SS> \<FF> : \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms
	unfolding cf_lcomp_def
	by (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_lcomp_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA>' = \<AA> \<times>\<^sub>C \<CC>"
	shows "cf_lcomp \<CC> \<SS> \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_lcomp_is_functor)

	lemma cf_rcomp_is_functor:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_rcomp \<BB> \<SS> \<GG> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms
	unfolding cf_rcomp_def
	by (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_rcomp_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA>' = \<BB> \<times>\<^sub>C \<AA>"
	shows "cf_rcomp \<BB> \<SS> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_rcomp_is_functor)



	subsection\<open>Composition of a contracovariant bifunctor and a covariant functor\<close>

	definition cf_cn_cov_lcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_cn_cov_lcomp \<CC> \<SS> \<FF> = cf_cn_cov_bcomp \<SS> \<FF> (cf_id \<CC>)"

	definition cf_cn_cov_rcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_cn_cov_rcomp \<BB> \<SS> \<GG> = cf_cn_cov_bcomp \<SS> (cf_id \<BB>) \<GG>"


	text\<open>Components.\<close>

	lemma cf_cn_cov_lcomp_components:
	shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<CC>"
	and "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_cn_cov_lcomp_def cf_cn_cov_bcomp_components dghm_id_components
	by simp_all

	lemma cf_cn_cov_rcomp_components:
	shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>HomDom\<rparr> = op_cat \<BB> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
	and "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
	unfolding cf_cn_cov_rcomp_def cf_cn_cov_bcomp_components dghm_id_components
	by simp_all


	subsubsection\<open>Object map\<close>

	lemma cf_cn_cov_lcomp_ObjMap_vsv: "vsv (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)

	lemma cf_cn_cov_rcomp_ObjMap_vsv: "vsv (cf_cn_cov_rcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)

	lemma cf_cn_cov_lcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_cn_cov_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_cn_cov_rcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) = (op_cat \<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_cn_cov_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_cn_cov_lcomp_ObjMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, c\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, c\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_cn_cov_lcomp_def cat_op_simps
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)

	lemma cf_cn_cov_rcomp_ObjMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b, \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_cn_cov_rcomp_def cat_op_simps
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)

	lemma cf_cn_cov_lcomp_ObjMap_vrange:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_cn_cov_lcomp_def
	by (intro cf_cn_cov_bcomp_ObjMap_vrange)
	(cs_concl cs_intro: cat_cs_intros)+

	lemma cf_cn_cov_rcomp_ObjMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_cn_cov_rcomp_def
	by (intro cf_cn_cov_bcomp_ObjMap_vrange)
	(cs_concl cs_intro: cat_cs_intros)+


	subsubsection\<open>Arrow map\<close>

	lemma cf_cn_cov_lcomp_ArrMap_vsv: "vsv (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)

	lemma cf_cn_cov_rcomp_ArrMap_vsv: "vsv (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>)"
	unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)

	lemma cf_cn_cov_lcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_cn_cov_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_cn_cov_rcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) = (op_cat \<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_cn_cov_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_cn_cov_lcomp_ArrMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "f \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, g\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_cn_cov_lcomp_def cat_op_simps
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)

	lemma cf_cn_cov_rcomp_ArrMap_app[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "f \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding cf_cn_cov_rcomp_def cat_op_simps
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)

	lemma cf_cn_cov_lcomp_ArrMap_vrange:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_cn_cov_lcomp_def
	by (intro cf_cn_cov_bcomp_ArrMap_vrange)
	(cs_concl cs_intro: cat_cs_intros)+

	lemma cf_cn_cov_rcomp_ArrMap_vrange:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<R>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	using assms
	unfolding cf_cn_cov_rcomp_def cat_op_simps
	by (intro cf_cn_cov_bcomp_ArrMap_vrange)
	(cs_concl cs_intro: cat_cs_intros)+


	subsubsection\<open>
	Composition of a contracovariant bifunctor and a covariant functor is a functor
	\<close>

	lemma cf_cn_cov_lcomp_is_functor:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF> : op_cat \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms
	unfolding cf_cn_cov_lcomp_def cat_op_simps
	by (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_cn_cov_lcomp_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA>\<CC> = op_cat \<AA> \<times>\<^sub>C \<CC>"
	shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF> : \<AA>\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_lcomp_is_functor)

	lemma cf_cn_cov_rcomp_is_functor:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG> : op_cat \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms
	unfolding cf_cn_cov_rcomp_def cat_op_simps
	by (cs_concl cs_intro: cat_cs_intros)+

	lemma cf_cn_cov_rcomp_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<BB>\<AA> = op_cat \<BB> \<times>\<^sub>C \<AA>"
	shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG> : \<BB>\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_rcomp_is_functor)


	subsubsection\<open>
	Projection of a composition of a contracovariant bifunctor and a covariant
	functor
	\<close>

	lemma cf_cn_cov_rcomp_bifunctor_proj_snd[cat_cs_simps]:
	assumes "category \<alpha> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows
	"cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<^bsub>op_cat \<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F =
	(\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>"
	using assms
	unfolding cf_cn_cov_rcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	lemma cf_cn_cov_lcomp_bifunctor_proj_snd[cat_cs_simps]:
	assumes "category \<alpha> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows
	"cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<^bsub>op_cat \<AA>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F =
	(\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F)"
	using assms
	unfolding cf_cn_cov_lcomp_def
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)



	subsection\<open>Composition of bifunctors\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	definition cf_blcomp :: "V \<Rightarrow> V"
	where "cf_blcomp \<SS> =
	cf_lcomp (\<SS>\<lparr>HomCod\<rparr>) \<SS> \<SS> \<circ>\<^sub>C\<^sub>F
	cf_cat_prod_21_of_3 (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>)"

	definition cf_brcomp :: "V \<Rightarrow> V"
	where "cf_brcomp \<SS> =
	cf_rcomp (\<SS>\<lparr>HomCod\<rparr>) \<SS> \<SS> \<circ>\<^sub>C\<^sub>F
	cf_cat_prod_12_of_3 (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>)"


	text\<open>Alternative forms of the definitions.\<close>

	lemma cf_blcomp_def':
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cf_blcomp \<SS> = cf_lcomp \<CC> \<SS> \<SS> \<circ>\<^sub>C\<^sub>F cf_cat_prod_21_of_3 \<CC> \<CC> \<CC>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cf_blcomp_def cs_intro: cat_cs_intros
	)
	qed

	lemma cf_brcomp_def':
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cf_brcomp \<SS> = cf_rcomp \<CC> \<SS> \<SS> \<circ>\<^sub>C\<^sub>F cf_cat_prod_12_of_3 \<CC> \<CC> \<CC>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cf_brcomp_def cs_intro: cat_cs_intros
	)
	qed


	subsubsection\<open>Compositions of bifunctors are functors\<close>

	lemma cf_blcomp_is_functor:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cf_blcomp \<SS> : \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	show ?thesis
	by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def' cs_intro: cat_cs_intros)
	qed

	lemma cf_blcomp_is_functor'[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<AA>' = \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"
	shows "cf_blcomp \<SS> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1) unfolding assms(2) by (rule cf_blcomp_is_functor)

	lemma cf_brcomp_is_functor:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cf_brcomp \<SS> : \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	show ?thesis
	by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def' cs_intro: cat_cs_intros)
	qed

	lemma cf_brcomp_is_functor'[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<AA>' = \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"
	shows "cf_brcomp \<SS> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1) unfolding assms(2) by (rule cf_brcomp_is_functor)


	subsubsection\<open>Object map\<close>

	lemma cf_blcomp_ObjMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "vsv (cf_blcomp \<SS>\<lparr>ObjMap\<rparr>)"
	proof-
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms])
	show ?thesis by auto
	qed

	lemma cf_brcomp_ObjMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "vsv (cf_brcomp \<SS>\<lparr>ObjMap\<rparr>)"
	proof-
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms])
	show ?thesis by auto
	qed

	lemma cf_blcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_blcomp \<SS>\<lparr>ObjMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms])
	show ?thesis
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma cf_brcomp_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_brcomp \<SS>\<lparr>ObjMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms])
	show ?thesis
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma cf_blcomp_ObjMap_app[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "A = [a, b, c]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_blcomp \<SS>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = (a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> b) \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> c"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms(1)])
	from assms(3-5) show ?thesis
	unfolding assms(2)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def'
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed

	lemma cf_brcomp_ObjMap_app[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "A = [a, b, c]\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_brcomp \<SS>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> (b \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> c)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms(1)])
	from assms(3-5) show ?thesis
	unfolding assms(2)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma cf_blcomp_ArrMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "vsv (cf_blcomp \<SS>\<lparr>ArrMap\<rparr>)"
	proof-
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms])
	show ?thesis by auto
	qed

	lemma cf_brcomp_ArrMap_vsv[cat_cs_intros]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "vsv (cf_brcomp \<SS>\<lparr>ArrMap\<rparr>)"
	proof-
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms])
	show ?thesis by auto
	qed

	lemma cf_blcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_blcomp \<SS>\<lparr>ArrMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms])
	show ?thesis
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma cf_brcomp_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (cf_brcomp \<SS>\<lparr>ArrMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms])
	show ?thesis
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma cf_blcomp_ArrMap_app[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "F = [h, g, f]\<^sub>\<circ>"
	and "h \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "cf_blcomp \<SS>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = (h \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> g) \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
	by (rule cf_blcomp_is_functor[OF assms(1)])
	from assms(3-5) show ?thesis
	unfolding assms(2)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def'
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed

	lemma cf_brcomp_ArrMap_app[cat_cs_simps]:
	assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "F = [h, g, f]\<^sub>\<circ>"
	and "h \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "cf_brcomp \<SS>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = h \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> (g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f)"
	proof-
	interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
	interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
	by (rule cf_brcomp_is_functor[OF assms(1)])
	from assms(3-5) show ?thesis
	unfolding assms(2)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed



	subsection\<open>Binatural transformation\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	text\<open>
	In this work, a \<open>binatural transformation\<close> is used to denote a natural
	transformation of bifunctors.
	\<close>

	definition bnt_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_\<^bsub>_,_\<^esub>/'(/-,_/')/\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
	where "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>),
	\<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F,
	\<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F,
	\<AA>,
	\<NN>\<lparr>NTDGCod\<rparr>
	]\<^sub>\<circ>"

	definition bnt_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>(_\<^bsub>_,_\<^esub>/'(/_,-/')/\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
	where "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F =
	[
	(\<lambda>b\<in>\<^sub>\<circ>\<BB>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>),
	\<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F,
	\<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F,
	\<BB>,
	\<NN>\<lparr>NTDGCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components\<close>

	lemma bnt_proj_fst_components:
	shows "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGDom\<rparr> = \<AA>"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
	unfolding bnt_proj_fst_def nt_field_simps by (simp_all add: nat_omega_simps)

	lemma bnt_proj_snd_components:
	shows "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<lambda>b\<in>\<^sub>\<circ>\<BB>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGDom\<rparr> = \<BB>"
	and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
	unfolding bnt_proj_snd_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation maps\<close>

	mk_VLambda bnt_proj_fst_components(1)[folded VLambda_vconst_on]
	\|vsv bnt_proj_fst_NTMap_vsv[cat_cs_intros]\|
	\|vdomain bnt_proj_fst_NTMap_vdomain[cat_cs_simps]\|
	\|app bnt_proj_fst_NTMap_app[cat_cs_simps]\|

	lemma bnt_proj_fst_vrange:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
	show ?thesis
	unfolding bnt_proj_fst_components
	proof(rule vrange_VLambda_vsubset)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_prod_cs_intros)
	qed
	qed

	mk_VLambda bnt_proj_snd_components(1)[folded VLambda_vconst_on]
	\|vsv bnt_proj_snd_NTMap_vsv[intro]\|
	\|vdomain bnt_proj_snd_NTMap_vdomain[cat_cs_simps]\|
	\|app bnt_proj_snd_NTMap_app[cat_cs_simps]\|

	lemma bnt_proj_snd_vrange:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
	show ?thesis
	unfolding bnt_proj_snd_components
	proof(rule vrange_VLambda_vsubset)
	fix b assume "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	with assms show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_prod_cs_intros)
	qed
	qed


	subsubsection\<open>Binatural transformation projection is a natural transformation\<close>

	lemma bnt_proj_snd_is_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
	show ?thesis
	proof(intro is_ntcfI')
	show "vfsequence (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)" unfolding bnt_proj_snd_def by simp
	show "vcard (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F) = 5\<^sub>\<nat>"
	unfolding bnt_proj_snd_def by (simp add: nat_omega_simps)
	from assms show "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms show "\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	using that assms
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
	if "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b" for a' b f
	using that assms
	by
	(
	cs_concl
	cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (auto simp: bnt_proj_snd_components cat_cs_simps)
	qed

	lemma bnt_proj_snd_is_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by (auto intro: bnt_proj_snd_is_ntcf)

	lemma bnt_proj_fst_is_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
	show ?thesis
	proof(intro is_ntcfI')
	show "vfsequence (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)" unfolding bnt_proj_fst_def by simp
	show "vcard (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F) = 5\<^sub>\<nat>"
	unfolding bnt_proj_fst_def by (simp add: nat_omega_simps)
	from assms show "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that assms
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b'" for a b' f
	using that assms
	by
	(
	cs_concl
	cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed (auto simp: bnt_proj_fst_components cat_cs_simps)
	qed

	lemma bnt_proj_fst_is_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "\<AA>' = \<AA>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1-4) unfolding assms(5-7) by (rule bnt_proj_fst_is_ntcf)


	subsubsection\<open>Array binatural transformation is a natural transformation\<close>

	lemma ntcf_array_is_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "vfsequence \<NN>"
	and "vcard \<NN> = 5\<^sub>\<nat>"
	and "\<NN>\<lparr>NTDom\<rparr> = \<SS>"
	and "\<NN>\<lparr>NTCod\<rparr> = \<SS>'"
	and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
	and "\<NN>\<lparr>NTDGCod\<rparr> = \<CC>"
	and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<NN>: vsv \<open>\<NN>\<lparr>NTMap\<rparr>\<close> by (rule assms(11))

	have [cat_cs_intros]:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; A = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>; B = \<SS>'\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<rbrakk> \<Longrightarrow>
	\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> : A \<mapsto>\<^bsub>\<CC>\<^esub> B"
	for a b A B
	by (auto intro: assms(13))

	show ?thesis
	proof(intro is_ntcfI')

	show "\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	if "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab
	proof-
	from that obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	from a b show ?thesis unfolding ab_def by (rule assms(13))
	qed

	show
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>a'b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> = \<SS>'\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
	if "gf : ab \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> a'b'" for ab a'b' gf
	proof-
	from that obtain g f a b a' b'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a'b'_def: "a'b' = [a', b']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	by (elim cat_prod_2_is_arrE[OF assms(1,2)])
	then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by auto
	show ?thesis
	unfolding gf_def ab_def a'b'_def
	proof-
	from is_ntcfD'(13)[OF assms(15)[OF b] g] g f assms(1,2,3,4)
	have [cat_cs_simps]:
	"(\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>) =
	(\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>)"
	by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
	from is_ntcfD'(13)[OF assms(14)[OF a'] f] g f assms(1,2)
	have \<SS>'\<NN>:
	"\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> =
	\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet>"
	by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
	from g f assms(1-4) have [cat_cs_simps]:
	"\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) =
	\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q)"
	if "q : r \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ObjMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet>" for q r
	using that
	by
	(
	cs_concl
	cs_simp: \<SS>'\<NN> category.cat_Comp_assoc[symmetric]
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)

	from assms(1-4) g f have
	"\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
	\<SS>'\<lparr>ArrMap\<rparr>\<lparr>[\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1-4) g f have "\<dots> = \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	finally have \<SS>'_gf: "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	by simp
	from assms(1-4) g f have
	"\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>[\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1-4) g f have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_prod_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	finally have \<SS>_gf: "\<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	by simp
	from assms(1-4) g f assms(13)[OF a b] assms(13)[OF a' b] have
	"\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> =
	(\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	unfolding \<SS>'_gf
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1-4) g f have
	"\<dots> = (\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	\<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1-4) g f assms(13)[OF a' b'] have
	"\<dots> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	(\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1-4) g f assms(13)[OF a' b'] have
	"\<dots> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
	unfolding \<SS>_gf[symmetric] by simp
	finally show
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	by simp
	qed
	qed

	qed (auto simp: assms)

	qed


	subsubsection\<open>Binatural transformation projections and isomorphisms\<close>

	lemma is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(intro is_iso_ntcfI)
	show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	interpret \<NN>a: is_iso_ntcf
	\<alpha> \<BB> \<CC> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close> \<open>\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close> \<open>\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close>
	by (rule assms(4)[OF a])
	from b have \<NN>ab: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from \<NN>a.iso_ntcf_is_arr_isomorphism[OF b] assms(1,2,3) a b show
	+ from \<NN>a.iso_ntcf_is_iso_arr[OF b] assms(1,2,3) a b show
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps ab_def cs_intro: cat_prod_cs_intros
	)
	qed
	qed

	lemma is_iso_ntcf_if_bnt_proj_fst_is_iso_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(intro is_iso_ntcfI)
	show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	interpret \<NN>a: is_iso_ntcf
	\<alpha> \<AA> \<CC> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close> \<open>\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close> \<open>\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close>
	by (rule assms(4)[OF b])
	from b have \<NN>ab: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from \<NN>a.iso_ntcf_is_arr_isomorphism[OF a] assms(1,2,3) a b show
	+ from \<NN>a.iso_ntcf_is_iso_arr[OF a] assms(1,2,3) a b show
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	unfolding ab_def
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
	qed
	qed

	lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_iso_ntcfI)
	from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	using assms that
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
	)
	qed

	lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
	and "\<BB>' = \<BB>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	unfolding assms(4-6)
	by (rule bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])

	lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_iso_ntcfI)
	from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using assms that
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
	)
	qed

	lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
	and "\<AA>' = \<AA>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	unfolding assms(4-6)
	by (rule bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])



	subsection\<open>Binatural transformation flip\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition bnt_flip :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "bnt_flip \<AA> \<BB> \<NN> =
	[
	fflip (\<NN>\<lparr>NTMap\<rparr>),
	bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>),
	bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>),
	\<BB> \<times>\<^sub>C \<AA>,
	\<NN>\<lparr>NTDGCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma bnt_flip_components:
	shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> = fflip (\<NN>\<lparr>NTMap\<rparr>)"
	and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr> = bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>)"
	and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr> = bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>)"
	and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDGDom\<rparr> = \<BB> \<times>\<^sub>C \<AA>"
	and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
	unfolding bnt_flip_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<SS> \<SS>' \<NN>
	assumes \<NN>: "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule \<NN>)

	lemmas bnt_flip_components' =
	bnt_flip_components[where \<AA>=\<AA> and \<BB>=\<BB> and \<NN>=\<NN>, unfolded cat_cs_simps]

	lemmas [cat_cs_simps] = bnt_flip_components'(2-5)

	end


	subsubsection\<open>Natural transformation map\<close>

	lemma bnt_flip_NTMap_vsv[cat_cs_intros]: "vsv (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
	unfolding bnt_flip_components by (rule fflip_vsv)

	lemma bnt_flip_NTMap_app:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding bnt_flip_components
	by
	(
	cs_concl cs_shallow
	cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros
	)

	lemma bnt_flip_NTMap_app'[cat_cs_simps]:
	assumes "ba = [b, a]\<^sub>\<circ>"
	and "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	using assms(2-6) unfolding assms(1) by (rule bnt_flip_NTMap_app)

	lemma bnt_flip_NTMap_vdomain[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	using assms
	unfolding bnt_flip_components
	by (cs_concl cs_shallow cs_simp: V_cs_simps cat_cs_simps)

	lemma bnt_flip_NTMap_vrange[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) = \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))

	show ?thesis
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold bnt_flip_NTMap_vdomain[OF assms]
	)
	fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(2,1)])
	from \<NN>.ntcf_NTMap_vsv assms a b show
	"bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
	unfolding ba_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)

	show "\<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
	proof(intro vsv.vsv_vrange_vsubset, unfold \<NN>.ntcf_NTMap_vdomain)
	fix ab assume prems: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF assms(1,2)])
	from assms a b have ba: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_prod_cs_intros)
	from assms bnt_flip_NTMap_vsv prems a b ba show
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
	unfolding ab_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	qed auto

	qed

	qed


	subsubsection\<open>Binatural transformation flip natural transformation map\<close>

	lemma bnt_flip_NTMap_is_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bnt_flip \<AA> \<BB> \<NN> :
	bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' :
	\<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))

	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))

	show ?thesis
	proof(intro is_ntcfI')
	show "vfsequence (bnt_flip \<AA> \<BB> \<NN>)" unfolding bnt_flip_def by simp
	show "vcard (bnt_flip \<AA> \<BB> \<NN>) = 5\<^sub>\<nat>"
	unfolding bnt_flip_def by (simp add: nat_omega_simps)
	show "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> :
	bifunctor_flip \<AA> \<BB> \<SS>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
	bifunctor_flip \<AA> \<BB> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr>"
	if "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>" for ba
	proof-
	from that obtain b a
	where ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
	from assms a b show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps ba_def
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	show
	"bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>b'a'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bifunctor_flip \<AA> \<BB> \<SS>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> =
	bifunctor_flip \<AA> \<BB> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr>"
	if "gf : ba \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> b'a'" for ba b'a' gf
	proof-
	from that obtain g f a b a' b'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and ba_def: "ba = [b, a]\<^sub>\<circ>"
	and b'a'_def: "b'a' = [b', a']\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
	by (elim cat_prod_2_is_arrE[OF assms(2,1)])
	from assms g f show ?thesis
	unfolding gf_def ba_def b'a'_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_cs_simps \<NN>.ntcf_Comp_commute
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed

	qed
	(
	use assms in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	)+

	qed

	lemma bnt_flip_NTMap_is_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<T> = bifunctor_flip \<AA> \<BB> \<SS>"
	and "\<T>' = bifunctor_flip \<AA> \<BB> \<SS>'"
	and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
	shows "bnt_flip \<AA> \<BB> \<NN> : \<T> \<mapsto>\<^sub>C\<^sub>F \<T>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1-3) unfolding assms(4-6) by (intro bnt_flip_NTMap_is_ntcf)


	subsubsection\<open>Double-flip of a binatural transformation\<close>

	lemma bnt_flip_flip[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>) = \<NN>"
	proof(rule ntcf_eqI)
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
	from assms show
	"bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>) : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> (bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
	then have dom_rhs: "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (rule cat_prod_2_ObjE[OF assms(1,2)])
	from assms a b show
	"bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps ab_def cs_intro: cat_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros)+
	qed simp_all


	subsubsection\<open>A projection of a flip of a binatural transformation\<close>

	lemma bnt_flip_proj_snd[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F"
	proof(rule ntcf_eqI)
	from assms show "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F :
	\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F :
	\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have dom_lhs:
	"\<D>\<^sub>\<circ> ((bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms have dom_rhs: "\<D>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "(bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms show
	"(bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	qed (auto simp: cat_cs_intros)
	qed simp_all

	lemma bnt_flip_proj_fst[cat_cs_simps]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(-,a)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F"
	proof-
	from assms have f_\<NN>:
	"bnt_flip \<AA> \<BB> \<NN> :
	bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' :
	\<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show ?thesis
	by
	(
	rule
	bnt_flip_proj_snd
	[
	OF assms(2,1) f_\<NN> assms(4),
	unfolded bnt_flip_flip[OF assms(1,2,3)],
	symmetric
	]
	)
	qed


	subsubsection\<open>A flip of a binatural isomorphism\<close>

	lemma bnt_flip_is_iso_ntcf:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "bnt_flip \<AA> \<BB> \<NN> :
	bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o bifunctor_flip \<AA> \<BB> \<SS>' :
	\<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf)
	from assms show f_\<NN>: "bnt_flip \<AA> \<BB> \<NN> :
	bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' :
	\<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
	fix a assume "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	with assms f_\<NN> show
	"bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>C\<^sub>F :
	\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
	qed (simp_all add: assms)

	lemma bnt_flip_is_iso_ntcf'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> = bifunctor_flip \<AA> \<BB> \<SS>"
	and "\<GG> = bifunctor_flip \<AA> \<BB> \<SS>'"
	and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
	shows "bnt_flip \<AA> \<BB> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using bnt_flip_is_iso_ntcf[OF assms(1-3)] unfolding assms(4-6) by simp

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Par.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Par.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Par.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Par.thy
	@@ -1,308 +1,315 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Par\<close>\<close>
	theory CZH_ECAT_Par
	imports
	CZH_Foundations.CZH_SMC_Par
	CZH_ECAT_Rel
	CZH_ECAT_Subcategory
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition of \<open>Par\<close> as a category is
	analogous to the one used in \cite{milehins_category_2021}
	for the exposition of \<open>Par\<close> as a semicategory.
	\<close>

	named_theorems cat_Par_cs_simps
	named_theorems cat_Par_cs_intros

	-lemmas (in arr_Rel) [cat_Par_cs_simps] =
	+lemmas (in arr_Par) [cat_Par_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Par) [cat_cs_intros, cat_Par_cs_intros] =
	+ arr_Par_axioms'
	+
	lemmas [cat_Par_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Par.arr_Par_length
	arr_Par_comp_Par_id_Par_left
	arr_Par_comp_Par_id_Par_right

	lemmas [cat_Par_cs_intros] =
	arr_Par_comp_Par



	subsection\<open>\<open>Par\<close> as a category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_Par :: "V \<Rightarrow> V"
	where "cat_Par \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Par \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Par \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>),
	VLambda (Vset \<alpha>) id_Par
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_Par_components:
	shows "cat_Par \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "cat_Par \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Par \<alpha> T}"
	and "cat_Par \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "cat_Par \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "cat_Par \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Par \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>P\<^sub>a\<^sub>r ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_Par \<alpha>\<lparr>CId\<rparr> = VLambda (Vset \<alpha>) id_Par"
	unfolding cat_Par_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_Par: "cat_smc (cat_Par \<alpha>) = smc_Par \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_Par \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_Par \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Par_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_Par \<alpha>)) = \<D>\<^sub>\<circ> (smc_Par \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_Par \<alpha>)) \<Longrightarrow> cat_smc (cat_Par \<alpha>)\<lparr>a\<rparr> = smc_Par \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_Par_def smc_Par_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: cat_smc_def smc_Par_def)

	lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]:
	cat_Par_Obj_iff = smc_Par_Obj_iff
	and cat_Par_Arr_iff[cat_Par_cs_simps] = smc_Par_Arr_iff
	and cat_Par_Dom_vsv[cat_Par_cs_intros] = smc_Par_Dom_vsv
	and cat_Par_Dom_vdomain[cat_Par_cs_simps] = smc_Par_Dom_vdomain
	and cat_Par_Dom_vrange = smc_Par_Dom_vrange
	and cat_Par_Dom_app[cat_Par_cs_simps] = smc_Par_Dom_app
	and cat_Par_Cod_vsv[cat_Par_cs_intros] = smc_Par_Cod_vsv
	and cat_Par_Cod_vdomain[cat_Par_cs_simps] = smc_Par_Cod_vdomain
	and cat_Par_Cod_vrange = smc_Par_Cod_vrange
	and cat_Par_Cod_app[cat_Par_cs_simps] = smc_Par_Cod_app
	and cat_Par_is_arrI = smc_Par_is_arrI
	and cat_Par_is_arrD = smc_Par_is_arrD
	and cat_Par_is_arrE = smc_Par_is_arrE

	lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]:
	cat_Par_composable_arrs_dg_Par = smc_Par_composable_arrs_dg_Par
	and cat_Par_Comp = smc_Par_Comp
	and cat_Par_Comp_app[cat_Par_cs_simps] = smc_Par_Comp_app
	and cat_Par_Comp_vdomain[cat_Par_cs_simps] = smc_Par_Comp_vdomain
	+ and cat_Par_is_monic_arrI = smc_Par_is_monic_arrI
	+ and cat_Par_is_monic_arrD = smc_Par_is_monic_arrD
	+ and cat_Par_is_monic_arr = smc_Par_is_monic_arr
	+ and cat_Par_is_epic_arrI = smc_Par_is_epic_arrI
	+ and cat_Par_is_epic_arrD = smc_Par_is_epic_arrD
	+ and cat_Par_is_epic_arr = smc_Par_is_epic_arr

	lemmas [cat_cs_simps] = cat_Par_is_arrD(2,3)

	lemmas [cat_Par_cs_intros] = cat_Par_is_arrI

	lemmas_with (in \<Z>) [folded cat_smc_cat_Par, unfolded slicing_simps]:
	cat_Par_Hom_vifunion_in_Vset = smc_Par_Hom_vifunion_in_Vset
	and cat_Par_incl_Par_is_arr = smc_Par_incl_Par_is_arr
	and cat_Par_incl_Par_is_arr'[cat_Par_cs_intros] = smc_Par_incl_Par_is_arr'
	and cat_Par_Comp_vrange = smc_Par_Comp_vrange
	- and cat_Par_is_monic_arrI = smc_Par_is_monic_arrI
	- and cat_Par_is_monic_arr = smc_Par_is_monic_arr
	- and cat_Par_is_epic_arrI = smc_Par_is_epic_arrI
	- and cat_Par_is_epic_arrD = smc_Par_is_epic_arrD
	- and cat_Par_is_epic_arr = smc_Par_is_epic_arr
	and cat_Par_obj_terminal = smc_Par_obj_terminal
	and cat_Par_obj_initial = smc_Par_obj_initial
	and cat_Par_obj_terminal_obj_initial = smc_Par_obj_terminal_obj_initial
	and cat_Par_obj_null = smc_Par_obj_null
	and cat_Par_is_zero_arr = smc_Par_is_zero_arr

	lemmas [cat_Par_cs_intros] = \<Z>.cat_Par_incl_Par_is_arr'


	subsubsection\<open>Identity\<close>

	lemma cat_Par_CId_app[cat_Par_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> = id_Par A"
	using assms unfolding cat_Par_components by simp

	lemma id_Par_CId_app_app[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "a \<in>\<^sub>\<circ> A"
	shows "cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = a"
	unfolding cat_Par_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp


	subsubsection\<open>\<open>Par\<close> is a category\<close>

	lemma (in \<Z>) category_cat_Par: "category \<alpha> (cat_Par \<alpha>)"
	proof(intro categoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par cat_op_simps)

	interpret Par: semicategory \<alpha> \<open>cat_smc (cat_Par \<alpha>)\<close>
	unfolding cat_smc_cat_Par by (simp add: semicategory_smc_Par)

	show "vfsequence (cat_Par \<alpha>)" unfolding cat_Par_def by simp
	show "vcard (cat_Par \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_Par_def by (simp add: nat_omega_simps)
	show "cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> A" if "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" for A
	using that
	unfolding cat_Par_Obj_iff
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Par_cs_simps cs_intro: cat_Par_cs_intros arr_Par_id_ParI
	)

	show "cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Par \<alpha>\<^esub> F = F"
	if "F : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B" for F A B
	proof-
	from that have "arr_Par \<alpha> F" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
	with that \<Z>_axioms show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Par_cs_simps
	cs_intro: cat_Par_cs_intros arr_Par_id_ParI
	)
	qed

	show "F \<circ>\<^sub>A\<^bsub>cat_Par \<alpha>\<^esub> cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> = F"
	if "F : B \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> C" for F B C
	proof-
	from that have "arr_Par \<alpha> F" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Par_cs_simps
	cs_intro: cat_Par_cs_intros arr_Par_id_ParI
	)
	qed

	qed (auto simp: semicategory_smc_Par cat_Par_components)


	subsubsection\<open>\<open>Par\<close> is a wide replete subcategory of \<open>Rel\<close>\<close>

	lemma (in \<Z>) wide_replete_subcategory_cat_Par_cat_Rel:
	"cat_Par \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof(intro wide_replete_subcategoryI)
	show wide_subcategory_cat_Par_cat_Rel: "cat_Par \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof(intro wide_subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	interpret Par: category \<alpha> \<open>cat_Par \<alpha>\<close> by (rule category_cat_Par)
	interpret wide_subsemicategory \<alpha> \<open>smc_Par \<alpha>\<close> \<open>smc_Rel \<alpha>\<close>
	by (simp add: wide_subsemicategory_smc_Par_smc_Rel)
	show "cat_Par \<alpha> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof(intro subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
	show "smc_Par \<alpha> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>" by (simp add: subsemicategory_axioms)
	fix A assume "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	then show "cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	unfolding cat_Par_components cat_Rel_components by simp
	qed
	(
	auto simp:
	subsemicategory_axioms Rel.category_axioms Par.category_axioms
	)
	qed (rule wide_subsemicategory_smc_Par_smc_Rel)
	show "cat_Par \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof(intro replete_subcategoryI)
	interpret wide_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_subcategory_cat_Par_cat_Rel)
	show "cat_Par \<alpha> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>" by (rule subcategory_axioms)
	fix A B F assume prems: "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	- note arr_Rel = cat_Rel_is_arr_isomorphismD[OF prems(2)]
	+ note arr_Rel = cat_Rel_is_iso_arrD[OF prems(2)]
	from arr_Rel(2) show "F : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B"
	by (intro cat_Par_is_arrI arr_Par_arr_RelI cat_Rel_is_arrD[OF arr_Rel(1)])
	auto
	qed
	qed



	subsection\<open>Isomorphism\<close>

	-lemma (in \<Z>) cat_Par_is_arr_isomorphismI[intro]:
	+lemma cat_Par_is_iso_arrI[intro]:
	assumes "T : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	shows "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	proof-
	- note [cat_cs_intros] = cat_Rel_is_arr_isomorphismI
	- from wide_replete_subcategory_cat_Par_cat_Rel assms have
	+ interpret T: arr_Par \<alpha> T by (intro cat_Par_is_arrD(1)[OF assms(1)])
	+ note [cat_cs_intros] = cat_Rel_is_iso_arrI
	+ from T.wide_replete_subcategory_cat_Par_cat_Rel assms have
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
	- with wide_replete_subcategory_cat_Par_cat_Rel assms show
	+ with T.wide_replete_subcategory_cat_Par_cat_Rel assms show
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_simp: cat_sub_bw_cs_simps)
	qed

	-lemma (in \<Z>) cat_Par_is_arr_isomorphismD[dest]:
	+lemma cat_Par_is_iso_arrD[dest]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof-
	- from wide_replete_subcategory_cat_Par_cat_Rel assms have T:
	+ interpret T: arr_Par \<alpha> T
	+ by (intro cat_Par_is_arrD(1)[OF is_iso_arrD(1)[OF assms(1)]])
	+ from T.wide_replete_subcategory_cat_Par_cat_Rel assms have T:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
	show "v11 (T\<lparr>ArrVal\<rparr>)" "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A" "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	- by (intro cat_Rel_is_arr_isomorphismD[OF T])+
	-qed (rule is_arr_isomorphismD(1)[OF assms])
	+ by (intro cat_Rel_is_iso_arrD[OF T])+
	+qed (rule is_iso_arrD(1)[OF assms])

	-lemma (in \<Z>) cat_Par_is_arr_isomorphism:
	+lemma cat_Par_is_iso_arr:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B \<and>
	v11 (T\<lparr>ArrVal\<rparr>) \<and>
	\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A \<and>
	\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	by auto



	subsection\<open>The inverse arrow\<close>

	abbreviation (input) converse_Par :: "V \<Rightarrow> V" ("(_\<inverse>\<^sub>P\<^sub>a\<^sub>r)" [1000] 999)
	where "a\<inverse>\<^sub>P\<^sub>a\<^sub>r \<equiv> a\<inverse>\<^sub>R\<^sub>e\<^sub>l"

	-lemma (in \<Z>) cat_Par_the_inverse:
	+lemma cat_Par_the_inverse[cat_Par_cs_simps]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	shows "T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub> = T\<inverse>\<^sub>P\<^sub>a\<^sub>r"
	proof-
	- from wide_replete_subcategory_cat_Par_cat_Rel assms have T:
	+ interpret T: arr_Par \<alpha> T
	+ by (intro cat_Par_is_arrD(1)[OF is_iso_arrD(1)[OF assms(1)]])
	+ from T.wide_replete_subcategory_cat_Par_cat_Rel assms have T:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
	- from wide_replete_subcategory_cat_Par_cat_Rel assms
	+ from T.wide_replete_subcategory_cat_Par_cat_Rel assms
	have [symmetric, cat_cs_simps]: "T\<inverse>\<^sub>C\<^bsub>cat_Rel \<alpha>\<^esub> = T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros
	)
	- from T show "T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub> = T\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	+ from T show "T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub> = T\<inverse>\<^sub>P\<^sub>a\<^sub>r"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	qed

	-lemmas [cat_Par_cs_simps] = \<Z>.cat_Par_the_inverse
	-
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Parallel.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Parallel.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Parallel.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Parallel.thy
	@@ -1,1789 +1,1789 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	-section\<open>\<open>\<Up>\<close>: category with parallel arrows between two objects\<close>
	+section\<open>Categories with parallel arrows between two objects\<close>
	theory CZH_ECAT_Parallel
	imports CZH_ECAT_Small_Functor
	begin



	subsection\<open>Background: category with parallel arrows between two objects\<close>

	named_theorems cat_parallel_cs_simps
	named_theorems cat_parallel_cs_intros

	definition \<aa>\<^sub>P\<^sub>L :: "V \<Rightarrow> V" where "\<aa>\<^sub>P\<^sub>L F = set {F, 0}"
	definition \<bb>\<^sub>P\<^sub>L :: "V \<Rightarrow> V" where "\<bb>\<^sub>P\<^sub>L F = set {F, 1\<^sub>\<nat>}"

	lemma cat_PL_\<aa>_nin_F[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L F \<notin>\<^sub>\<circ> F"
	unfolding \<aa>\<^sub>P\<^sub>L_def using mem_not_sym by auto

	lemma cat_PL_\<bb>_nin_F[cat_parallel_cs_intros]: "\<bb>\<^sub>P\<^sub>L F \<notin>\<^sub>\<circ> F"
	unfolding \<bb>\<^sub>P\<^sub>L_def using mem_not_sym by auto

	lemma cat_PL_\<aa>\<bb>[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L F \<noteq> \<bb>\<^sub>P\<^sub>L F"
	unfolding \<aa>\<^sub>P\<^sub>L_def \<bb>\<^sub>P\<^sub>L_def by (simp add: Set.doubleton_eq_iff)

	lemmas cat_PL_\<bb>\<aa>[cat_parallel_cs_intros] = cat_PL_\<aa>\<bb>[symmetric]



	subsection\<open>
	Composable arrows for a category with parallel arrows between two objects
	\<close>

	definition cat_parallel_composable :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cat_parallel_composable \<aa> \<bb> F \<equiv>
	set {[\<aa>, \<aa>]\<^sub>\<circ>, [\<bb>, \<bb>]\<^sub>\<circ>} \<union>\<^sub>\<circ>
	(F \<times>\<^sub>\<bullet> set {\<aa>}) \<union>\<^sub>\<circ>
	(set {\<bb>} \<times>\<^sub>\<bullet> F)"


	text\<open>Rules.\<close>

	lemma cat_parallel_composable_\<aa>\<aa>[cat_parallel_cs_intros]:
	assumes "g = \<aa>" and "f = \<aa>"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	unfolding assms cat_parallel_composable_def by auto

	lemma cat_parallel_composable_\<bb>\<ff>[cat_parallel_cs_intros]:
	assumes "g = \<bb>" and "f \<in>\<^sub>\<circ> F"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	using assms(2) unfolding assms(1) cat_parallel_composable_def by auto

	lemma cat_parallel_composable_\<ff>\<aa>[cat_parallel_cs_intros]:
	assumes "g \<in>\<^sub>\<circ> F" and "f = \<aa>"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	using assms(1) unfolding assms(2) cat_parallel_composable_def by auto

	lemma cat_parallel_composable_\<bb>\<bb>[cat_parallel_cs_intros]:
	assumes "g = \<bb>" and "f = \<bb>"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	unfolding assms cat_parallel_composable_def by auto

	lemma cat_parallel_composableE:
	assumes "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	obtains "g = \<bb>" and "f = \<bb>"
	\| "g = \<bb>" and "f \<in>\<^sub>\<circ> F"
	\| "g \<in>\<^sub>\<circ> F" and "f = \<aa>"
	\| "g = \<aa>" and "f = \<aa>"
	using assms that unfolding cat_parallel_composable_def by auto


	text\<open>Elementary properties.\<close>

	lemma cat_parallel_composable_fconverse:
	"(cat_parallel_composable \<aa> \<bb> F)\<inverse>\<^sub>\<bullet> = cat_parallel_composable \<bb> \<aa> F"
	unfolding cat_parallel_composable_def by auto



	subsection\<open>
	Local assumptions for a category with parallel arrows between two objects
	\<close>

	locale cat_parallel = \<Z> \<alpha> for \<alpha> +
	fixes \<aa> \<bb> F
	assumes cat_parallel_\<aa>\<bb>[cat_parallel_cs_intros]: "\<aa> \<noteq> \<bb>"
	and cat_parallel_\<aa>F[cat_parallel_cs_intros]: "\<aa> \<notin>\<^sub>\<circ> F"
	and cat_parallel_\<bb>F[cat_parallel_cs_intros]: "\<bb> \<notin>\<^sub>\<circ> F"
	and cat_parallel_\<aa>_in_Vset[cat_parallel_cs_intros]: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_parallel_\<bb>_in_Vset[cat_parallel_cs_intros]: "\<bb> \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_parallel_F_in_Vset[cat_parallel_cs_intros]: "F \<in>\<^sub>\<circ> Vset \<alpha>"

	lemmas (in cat_parallel) cat_parallel_ineq =
	cat_parallel_\<aa>\<bb>
	cat_parallel_\<aa>F
	cat_parallel_\<bb>F


	text\<open>Rules.\<close>

	lemmas (in cat_parallel) [cat_parallel_cs_intros] = cat_parallel_axioms

	mk_ide rf cat_parallel_def[unfolded cat_parallel_axioms_def]
	\|intro cat_parallelI\|
	\|dest cat_parallelD[dest]\|
	\|elim cat_parallelE[elim]\|


	text\<open>Duality.\<close>

	lemma (in cat_parallel) cat_parallel_op[cat_op_intros]:
	"cat_parallel \<alpha> \<bb> \<aa> F"
	by (intro cat_parallelI)
	(auto intro!: cat_parallel_cs_intros cat_parallel_\<aa>\<bb>[symmetric])


	text\<open>Elementary properties.\<close>

	lemma (in \<Z>) cat_parallel_PL:
	assumes "F \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "cat_parallel \<alpha> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F"
	proof (rule cat_parallelI)
	show "\<aa>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding \<aa>\<^sub>P\<^sub>L_def by (intro Limit_vdoubleton_in_VsetI assms) auto
	show "\<bb>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding \<bb>\<^sub>P\<^sub>L_def
	by (intro Limit_vdoubleton_in_VsetI ord_of_nat_in_Vset assms) simp
	qed (auto simp: assms cat_PL_\<aa>\<bb> cat_PL_\<aa>_nin_F cat_PL_\<bb>_nin_F)



	subsection\<open>\<open>\<Up>\<close>: category with parallel arrows between two objects\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-2 and Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	definition the_cat_parallel :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>\<Up>\<^sub>C\<close>)
	where "\<Up>\<^sub>C \<aa> \<bb> F =
	[
	set {\<aa>, \<bb>},
	set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F,
	(\<lambda>x\<in>\<^sub>\<circ>set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F. (x = \<bb> ? \<bb> : \<aa>)),
	(\<lambda>x\<in>\<^sub>\<circ>set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F. (x = \<aa> ? \<aa> : \<bb>)),
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_parallel_composable \<aa> \<bb> F.
	if gf = [\<bb>, \<bb>]\<^sub>\<circ> \<Rightarrow> \<bb>
	\| \<exists>f. gf = [\<bb>, f]\<^sub>\<circ> \<Rightarrow> gf\<lparr>1\<^sub>\<nat>\<rparr>
	\| \<exists>f. gf = [f, \<aa>]\<^sub>\<circ> \<Rightarrow> gf\<lparr>0\<rparr>
	\| otherwise \<Rightarrow> \<aa>
	),
	vid_on (set {\<aa>, \<bb>})
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma the_cat_parallel_components:
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr> = set {\<aa>, \<bb>}"
	and "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr> = set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F"
	and "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr> = (\<lambda>x\<in>\<^sub>\<circ>set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F. (x = \<bb> ? \<bb> : \<aa>))"
	and "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr> = (\<lambda>x\<in>\<^sub>\<circ>set {\<aa>, \<bb>} \<union>\<^sub>\<circ> F. (x = \<aa> ? \<aa> : \<bb>))"
	and "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Comp\<rparr> =
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_parallel_composable \<aa> \<bb> F.
	if gf = [\<bb>, \<bb>]\<^sub>\<circ> \<Rightarrow> \<bb>
	\| \<exists>f. gf = [\<bb>, f]\<^sub>\<circ> \<Rightarrow> gf\<lparr>1\<^sub>\<nat>\<rparr>
	\| \<exists>f. gf = [f, \<aa>]\<^sub>\<circ> \<Rightarrow> gf\<lparr>0\<rparr>
	\| otherwise \<Rightarrow> \<aa>
	)"
	and "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr> = vid_on (set {\<aa>, \<bb>})"
	unfolding the_cat_parallel_def dg_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Objects\<close>

	lemma the_cat_parallel_Obj_\<aa>I[cat_parallel_cs_intros]:
	assumes "a = \<aa>"
	shows "a \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_parallel_components by simp

	lemma the_cat_parallel_Obj_\<bb>I[cat_parallel_cs_intros]:
	assumes "a = \<bb>"
	shows "a \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_parallel_components by simp

	lemma the_cat_parallel_ObjE:
	assumes "a \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	obtains "a = \<aa>" \| "a = \<bb>"
	using assms unfolding the_cat_parallel_components(1) by fastforce


	subsubsection\<open>Arrows\<close>

	lemma the_cat_parallel_Arr_\<aa>I[cat_parallel_cs_intros]:
	assumes "f = \<aa>"
	shows "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_parallel_components by simp

	lemma the_cat_parallel_Arr_\<bb>I[cat_parallel_cs_intros]:
	assumes "f = \<bb>"
	shows "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_parallel_components by simp

	lemma the_cat_parallel_Arr_FI[cat_parallel_cs_intros]:
	assumes "f \<in>\<^sub>\<circ> F"
	shows "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_parallel_components by simp

	lemma the_cat_parallel_ArrE:
	assumes "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	obtains "f = \<aa>" \| "f = \<bb>" \| "f \<in>\<^sub>\<circ> F"
	using assms that unfolding the_cat_parallel_components by auto


	subsubsection\<open>Domain\<close>

	mk_VLambda the_cat_parallel_components(3)
	\|vsv the_cat_parallel_Dom_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cat_parallel_Dom_vdomain[cat_parallel_cs_simps]\|

	lemma (in cat_parallel) the_cat_parallel_Dom_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<bb>"
	unfolding the_cat_parallel_components assms by simp

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_\<bb>

	lemma (in cat_parallel) the_cat_parallel_Dom_app_F[cat_parallel_cs_simps]:
	assumes "f \<in>\<^sub>\<circ> F"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>"
	unfolding the_cat_parallel_components using assms cat_parallel_ineq by auto

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_F

	lemma (in cat_parallel) the_cat_parallel_Dom_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>"
	unfolding the_cat_parallel_components assms by auto

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_\<aa>


	subsubsection\<open>Codomain\<close>

	mk_VLambda the_cat_parallel_components(4)
	\|vsv the_cat_parallel_Cod_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cat_parallel_Cod_vdomain[cat_parallel_cs_simps]\|

	lemma (in cat_parallel) the_cat_parallel_Cod_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	unfolding the_cat_parallel_components assms by simp

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_\<bb>

	lemma (in cat_parallel) the_cat_parallel_Cod_app_F[cat_parallel_cs_simps]:
	assumes "f \<in>\<^sub>\<circ> F"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	unfolding the_cat_parallel_components using assms cat_parallel_ineq by auto

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_F

	lemma (in cat_parallel) the_cat_parallel_Cod_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<aa>"
	unfolding the_cat_parallel_components assms by auto

	lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_\<aa>


	subsubsection\<open>Composition\<close>

	mk_VLambda the_cat_parallel_components(5)
	\|vsv the_cat_parallel_Comp_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cat_parallel_Comp_vdomain[cat_parallel_cs_simps]\|
	\|app the_cat_parallel_Comp_app[cat_parallel_cs_simps]\|

	lemma the_cat_parallel_Comp_app_\<bb>\<bb>[cat_parallel_cs_simps]:
	assumes "g = \<bb>" and "f = \<bb>"
	shows "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	then show "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	unfolding the_cat_parallel_components(5) assms
	by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_parallel_Comp_app_\<aa>\<aa>[cat_parallel_cs_simps]:
	assumes "g = \<aa>" and "f = \<aa>"
	shows "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	by (cs_concl cs_intro: cat_parallel_cs_intros)
	then show "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	unfolding the_cat_parallel_components(5) assms
	by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_parallel_Comp_app_\<bb>F[cat_parallel_cs_simps]:
	assumes "g = \<bb>" and "f \<in>\<^sub>\<circ> F"
	shows "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	by (cs_concl cs_intro: cat_parallel_cs_intros)
	then show "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	unfolding the_cat_parallel_components(5) assms
	by (auto simp: nat_omega_simps)
	qed

	lemma (in cat_parallel) the_cat_parallel_Comp_app_F\<aa>[cat_parallel_cs_simps]:
	assumes "g \<in>\<^sub>\<circ> F" and "f = \<aa>"
	shows "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	by (cs_concl cs_intro: cat_parallel_cs_intros)
	then show "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = g"
	unfolding the_cat_parallel_components(5)
	using assms cat_parallel_ineq
	by (auto simp: nat_omega_simps)
	qed


	subsubsection\<open>Identity\<close>

	mk_VLambda the_cat_parallel_components(6)[unfolded VLambda_vid_on[symmetric]]
	\|vsv the_cat_parallel_CId_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cat_parallel_CId_vdomain[cat_parallel_cs_simps]\|
	\|app the_cat_parallel_CId_app\|

	lemma the_cat_parallel_CId_app_\<aa>[cat_parallel_cs_simps]:
	assumes "a = \<aa>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<aa>"
	unfolding assms by (auto simp: the_cat_parallel_CId_app)

	lemma the_cat_parallel_CId_app_\<bb>[cat_parallel_cs_simps]:
	assumes "a = \<bb>"
	shows "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<bb>"
	unfolding assms by (auto simp: the_cat_parallel_CId_app)


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma (in cat_parallel) the_cat_parallel_is_arr_\<aa>\<aa>\<aa>[cat_parallel_cs_intros]:
	assumes "a' = \<aa>" and "b' = \<aa>" and "f = \<aa>"
	shows "f : a' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>\<aa>\<rparr> = \<aa>" "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>\<aa>\<rparr> = \<aa>"
	by (cs_concl cs_shallow cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
	qed (auto simp: the_cat_parallel_components)

	lemma (in cat_parallel) the_cat_parallel_is_arr_\<bb>\<bb>\<bb>[cat_parallel_cs_intros]:
	assumes "a' = \<bb>" and "b' = \<bb>" and "f = \<bb>"
	shows "f : a' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>\<bb>\<rparr> = \<bb>" "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>\<bb>\<rparr> = \<bb>"
	by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
	qed (auto simp: the_cat_parallel_components)

	lemma (in cat_parallel) the_cat_parallel_is_arr_\<aa>\<bb>F[cat_parallel_cs_intros]:
	assumes "a' = \<aa>" and "b' = \<bb>" and "f \<in>\<^sub>\<circ> F"
	shows "f : a' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b'"
	proof(intro is_arrI, unfold assms(1,2))
	from assms(3) show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>" "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
	qed (auto simp: the_cat_parallel_components assms(3))

	lemma (in cat_parallel) the_cat_parallel_is_arrE:
	assumes "f' : a' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b'"
	obtains "a' = \<aa>" and "b' = \<aa>" and "f' = \<aa>"
	\| "a' = \<bb>" and "b' = \<bb>" and "f' = \<bb>"
	\| "a' = \<aa>" and "b' = \<bb>" and "f' \<in>\<^sub>\<circ> F"
	proof-
	note f = is_arrD[OF assms]
	from f(1) consider (\<aa>) \<open>f' = \<aa>\<close> \| (\<bb>) \<open>f' = \<bb>\<close> \| (F) \<open>f' \<in>\<^sub>\<circ> F\<close>
	unfolding the_cat_parallel_components(2) by auto
	then show ?thesis
	proof cases
	case \<aa>
	moreover from f(2)[unfolded \<aa>, symmetric] have "a' = \<aa>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros
	)
	moreover from f(3)[unfolded \<aa>, symmetric] have "b' = \<aa>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros
	)
	ultimately show ?thesis using that by auto
	next
	case \<bb>
	moreover from f(2)[unfolded \<bb>, symmetric] have "a' = \<bb>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros
	)
	moreover from f(3)[unfolded \<bb>, symmetric] have "b' = \<bb>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros
	)
	ultimately show ?thesis using that by auto
	next
	case F
	moreover from f(2)[symmetric] F have "a' = \<aa>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros
	)
	moreover from f(3)[symmetric] F have "b' = \<bb>"
	by (cs_prems cs_shallow cs_simp: cat_parallel_cs_simps)
	ultimately show ?thesis using that by auto
	qed
	qed


	subsubsection\<open>\<open>\<Up>\<close> is a category\<close>

	lemma (in cat_parallel) tiny_category_the_cat_parallel[cat_parallel_cs_intros]:
	"tiny_category \<alpha> (\<Up>\<^sub>C \<aa> \<bb> F)"
	proof(intro tiny_categoryI'')
	show "vfsequence (\<Up>\<^sub>C \<aa> \<bb> F)" unfolding the_cat_parallel_def by simp
	show "vcard (\<Up>\<^sub>C \<aa> \<bb> F) = 6\<^sub>\<nat>"
	unfolding the_cat_parallel_def by (simp_all add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	by (auto simp: the_cat_parallel_components)
	show "\<R>\<^sub>\<circ> (\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	by (auto simp: the_cat_parallel_components)
	show "(gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Comp\<rparr>)) =
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b)"
	for gf
	unfolding the_cat_parallel_Comp_vdomain
	proof
	assume prems: "gf \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	then obtain g f where gf_def: "gf = [g, f]\<^sub>\<circ>"
	unfolding cat_parallel_composable_def by auto
	from prems show
	"\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b"
	unfolding gf_def
	by (slow)
	(
	cases rule: cat_parallel_composableE;
	(intro exI conjI)?;
	cs_concl_step?;
	(simp only:)?,
	all\<open>intro is_arrI, unfold the_cat_parallel_components(2)\<close>
	)
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps V_cs_simps cs_intro: V_cs_intros
	)+
	next
	assume
	"\<exists>g f b' c' a'.
	gf = [g, f]\<^sub>\<circ> \<and> g : b' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c' \<and> f : a' \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b'"
	then obtain g f b c a
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b"
	by clarsimp
	from g f show "gf \<in>\<^sub>\<circ> cat_parallel_composable \<aa> \<bb> F"
	unfolding gf_def
	by (elim the_cat_parallel_is_arrE) (auto simp: cat_parallel_cs_intros)
	qed
	show "\<D>\<^sub>\<circ> (\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>) = \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	by (simp add: cat_parallel_cs_simps the_cat_parallel_components)
	show "g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c"
	if "g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c" and "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b" for b c g a f
	using that
	by (elim the_cat_parallel_is_arrE; simp only:)
	(
	all\<open>
	solves\<open>simp add: cat_parallel_\<aa>\<bb>[symmetric]\<close> \|
	cs_concl cs_simp: cat_parallel_cs_simps
	\<close>
	)
	show
	"h \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f =
	h \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> (g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f)"
	if "h : c \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> d"
	and "g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b"
	for c d h b g a f
	using that
	by (elim the_cat_parallel_is_arrE; simp only:) (slow)
	(
	all\<open>
	solves\<open>simp only: cat_parallel_ineq cat_parallel_\<aa>\<bb>[symmetric]\<close> \|
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	\<close>
	)
	show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> a" if "a \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	for a
	proof-
	from that consider \<open>a = \<aa>\<close> \| \<open>a = \<bb>\<close>
	unfolding the_cat_parallel_components(1) by auto
	then show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> a"
	by cases
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)+
	qed
	show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f = f"
	if "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b" for a b f
	using that
	by (elim the_cat_parallel_is_arrE)
	(cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
	show "f \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
	if "f : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c" for b c f
	using that
	by (elim the_cat_parallel_is_arrE)
	(cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
	show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: the_cat_parallel_components nat_omega_simps
	cs_intro: V_cs_intros cat_parallel_cs_intros
	)
	qed
	(
	cs_concl
	cs_simp:
	nat_omega_simps cat_parallel_cs_simps the_cat_parallel_components(2)
	cs_intro:
	cat_cs_intros
	cat_parallel_cs_intros
	V_cs_intros
	Limit_succ_in_VsetI
	)+

	lemmas [cat_parallel_cs_intros] = cat_parallel.tiny_category_the_cat_parallel


	subsubsection\<open>Opposite parallel category\<close>

	lemma (in cat_parallel) op_cat_the_cat_parallel[cat_op_simps]:
	"op_cat (\<Up>\<^sub>C \<aa> \<bb> F) = \<Up>\<^sub>C \<bb> \<aa> F"
	proof(rule cat_eqI)
	interpret par: cat_parallel \<alpha> \<bb> \<aa> F by (rule cat_parallel_op)
	show \<bb>\<aa>: "category \<alpha> (\<Up>\<^sub>C \<bb> \<aa> F)"
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
	show \<aa>\<bb>: "category \<alpha> (op_cat (\<Up>\<^sub>C \<aa> \<bb> F))"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_small_cs_intros cat_op_intros cat_parallel_cs_intros
	)
	interpret \<bb>\<aa>: category \<alpha> \<open>\<Up>\<^sub>C \<bb> \<aa> F\<close> by (rule \<bb>\<aa>)
	interpret \<aa>\<bb>: category \<alpha> \<open>\<Up>\<^sub>C \<aa> \<bb> F\<close>
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
	show "op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>Comp\<rparr> = \<Up>\<^sub>C \<bb> \<aa> F\<lparr>Comp\<rparr>"
	proof(rule vsv_eqI)
	show "vsv (op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>Comp\<rparr>)"
	unfolding op_cat_components by (rule fflip_vsv)
	show "vsv (\<Up>\<^sub>C \<bb> \<aa> F\<lparr>Comp\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	show [cat_op_simps]: "\<D>\<^sub>\<circ> (op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>Comp\<rparr>) = \<D>\<^sub>\<circ> (\<Up>\<^sub>C \<bb> \<aa> F\<lparr>Comp\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_parallel_composable_fconverse
	op_cat_components(5)
	vdomain_fflip
	cat_parallel_cs_simps
	cs_intro: cat_cs_intros
	)
	fix gf assume "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>Comp\<rparr>)"
	then have "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<Up>\<^sub>C \<bb> \<aa> F\<lparr>Comp\<rparr>)" unfolding cat_op_simps by simp
	then obtain g f a b c
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<bb> \<aa> F\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<bb> \<aa> F\<^esub> b"
	by auto
	from g f show "op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>Comp\<rparr>\<lparr>gf\<rparr> = \<Up>\<^sub>C \<bb> \<aa> F\<lparr>Comp\<rparr>\<lparr>gf\<rparr>"
	unfolding gf_def
	by (elim par.the_cat_parallel_is_arrE)
	(
	simp add: cat_parallel_cs_intros \|
	cs_concl
	cs_simp: cat_op_simps cat_parallel_cs_simps
	cs_intro: cat_cs_intros cat_parallel_cs_intros
	)+
	qed
	show "op_cat (\<Up>\<^sub>C \<aa> \<bb> F)\<lparr>CId\<rparr> = \<Up>\<^sub>C \<bb> \<aa> F\<lparr>CId\<rparr>"
	proof(unfold cat_op_simps, rule vsv_eqI, unfold cat_parallel_cs_simps)
	fix a assume "a \<in>\<^sub>\<circ> set {\<aa>, \<bb>}"
	then consider \<open>a = \<aa>\<close> \| \<open>a = \<bb>\<close> by auto
	then show "\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<Up>\<^sub>C \<bb> \<aa> F\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by cases (cs_concl cs_simp: cat_parallel_cs_simps)+
	qed auto
	qed (auto simp: the_cat_parallel_components op_cat_components)

	lemmas [cat_op_simps] = cat_parallel.op_cat_the_cat_parallel



	subsection\<open>Parallel functor\<close>


	subsubsection\<open>Background\<close>


	text\<open>
	See Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}).
	\<close>


	subsubsection\<open>Local assumptions for the parallel functor\<close>

	locale cf_parallel = cat_parallel \<alpha> \<aa> \<bb> F + category \<alpha> \<CC> + F': vsv F'
	for \<alpha> \<aa> \<bb> F \<aa>' \<bb>' F' \<CC> :: V +
	assumes cf_parallel_F'_vdomain[cat_parallel_cs_simps]: "\<D>\<^sub>\<circ> F' = F"
	and cf_parallel_F'[cat_parallel_cs_intros]: "\<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"
	and cf_parallel_\<aa>'[cat_parallel_cs_intros]: "\<aa>' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and cf_parallel_\<bb>'[cat_parallel_cs_intros]: "\<bb>' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"

	lemmas (in cf_parallel) [cat_parallel_cs_intros] = F'.vsv_axioms

	lemma (in cf_parallel) cf_parallel_F''[cat_parallel_cs_intros]:
	assumes "\<ff> \<in>\<^sub>\<circ> F" and "a = \<aa>'" and "b = \<bb>'"
	shows "F'\<lparr>\<ff>\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms(1) unfolding assms(2-3) by (rule cf_parallel_F')

	lemma (in cf_parallel) cf_parallel_F'''[cat_parallel_cs_intros]:
	assumes "\<ff> \<in>\<^sub>\<circ> F" and "f = F'\<lparr>\<ff>\<rparr>" and "b = \<bb>'"
	shows "f : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms(1) unfolding assms(2-3) by (rule cf_parallel_F')

	lemma (in cf_parallel) cf_parallel_F''''[cat_parallel_cs_intros]:
	assumes "\<ff> \<in>\<^sub>\<circ> F" and "f = F'\<lparr>\<ff>\<rparr>" and "a = \<aa>'"
	shows "f : a \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"
	using assms(1) unfolding assms(2,3) by (rule cf_parallel_F')


	text\<open>Rules.\<close>

	lemma (in cf_parallel) cf_parallel_axioms'[cat_parallel_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "a'' = \<aa>"
	and "b'' = \<bb>"
	and "F'' = F"
	and "a''' = \<aa>'"
	and "b''' = \<bb>'"
	and "F''' = F'"
	shows "cf_parallel \<alpha>' a'' b'' F'' a''' b''' F''' \<CC>"
	unfolding assms by (rule cf_parallel_axioms)

	mk_ide rf cf_parallel_def[unfolded cf_parallel_axioms_def]
	\|intro cf_parallelI\|
	\|dest cf_parallelD[dest]\|
	\|elim cf_parallelE[elim]\|

	lemmas [cat_parallel_cs_intros] = cf_parallelD(1,2)


	text\<open>Duality.\<close>

	lemma (in cf_parallel) cf_parallel_op[cat_op_intros]:
	"cf_parallel \<alpha> \<bb> \<aa> F \<bb>' \<aa>' F' (op_cat \<CC>)"
	by (intro cf_parallelI, unfold cat_op_simps insert_commute)
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps
	cs_intro: cat_parallel_cs_intros cat_cs_intros cat_op_intros
	)+

	lemmas [cat_op_intros] = cf_parallel.cf_parallel_op


	subsubsection\<open>Definition and elementary properties\<close>

	definition the_cf_parallel :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F\<close>)
	where "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F' =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>. (a = \<aa> ? \<aa>' : \<bb>')),
	(
	\<lambda>f\<in>\<^sub>\<circ>\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>.
	(
	if f = \<aa> \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>
	\| f = \<bb> \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>
	\| otherwise \<Rightarrow> F'\<lparr>f\<rparr>
	)
	),
	\<Up>\<^sub>C \<aa> \<bb> F,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma the_cf_parallel_components:
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>. (a = \<aa> ? \<aa>' : \<bb>'))"
	and "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>\<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>.
	(
	if f = \<aa> \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>
	\| f = \<bb> \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>
	\| otherwise \<Rightarrow> F'\<lparr>f\<rparr>
	)
	)"
	and [cat_parallel_cs_simps]: "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>HomDom\<rparr> = \<Up>\<^sub>C \<aa> \<bb> F"
	and [cat_parallel_cs_simps]: "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>HomCod\<rparr> = \<CC>"
	unfolding the_cf_parallel_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda the_cf_parallel_components(1)
	\|vsv the_cf_parallel_ObjMap_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cf_parallel_ObjMap_vdomain[cat_parallel_cs_simps]\|
	\|app the_cf_parallel_ObjMap_app\|

	lemma (in cf_parallel) the_cf_parallel_ObjMap_app_\<aa>[cat_parallel_cs_simps]:
	assumes "x = \<aa>"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<aa>'"
	by
	(
	cs_concl
	cs_simp:
	assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps
	cs_intro: cat_parallel_cs_intros
	)

	lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_\<aa>

	lemma (in cf_parallel) the_cf_parallel_ObjMap_app_\<bb>[cat_parallel_cs_simps]:
	assumes "x = \<bb>"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<bb>'"
	using cat_parallel_ineq
	by
	(
	cs_concl
	cs_simp:
	assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps
	cs_intro: cat_parallel_cs_intros
	)

	lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_\<bb>

	lemma (in cf_parallel) the_cf_parallel_ObjMap_vrange:
	"\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>) = set {\<aa>', \<bb>'}"
	proof(intro vsubset_antisym)
	show "\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> set {\<aa>', \<bb>'}"
	unfolding the_cf_parallel_components
	by (intro vrange_VLambda_vsubset)
	(simp_all add: cat_parallel_\<aa>\<bb> cf_parallel_\<aa>' cf_parallel_\<bb>')
	show "set {\<aa>', \<bb>'} \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>)"
	proof(rule vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> set {\<aa>', \<bb>'}"
	from prems consider \<open>x = \<aa>'\<close> \| \<open>x = \<bb>'\<close> by auto
	moreover have "\<aa>' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>)"
	by (rule vsv.vsv_vimageI2'[of _ _ \<aa>])
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)
	moreover have "\<bb>' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>)"
	by (rule vsv.vsv_vimageI2'[of _ _ \<bb>])
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)
	ultimately show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>)" by auto
	qed
	qed

	lemma (in cf_parallel) the_cf_parallel_ObjMap_vrange_vsubset_Obj:
	"\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	unfolding the_cf_parallel_components
	by (intro vrange_VLambda_vsubset)
	(simp_all add: cat_parallel_\<aa>\<bb> cf_parallel_\<aa>' cf_parallel_\<bb>')


	subsubsection\<open>Arrow map\<close>

	mk_VLambda the_cf_parallel_components(2)
	\|vsv the_cf_parallel_ArrMap_vsv[cat_parallel_cs_intros]\|
	\|vdomain the_cf_parallel_ArrMap_vdomain[cat_parallel_cs_simps]\|
	\|app the_cf_parallel_ArrMap_app\|

	lemma (in cf_parallel) the_cf_parallel_ArrMap_app_F[cat_parallel_cs_simps]:
	assumes "f \<in>\<^sub>\<circ> F"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = F'\<lparr>f\<rparr>"
	proof-
	from assms have "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros a_in_succ_xI)
	from assms this show ?thesis
	using cat_parallel_ineq
	by (auto simp: the_cf_parallel_ArrMap_app cat_parallel_cs_simps)
	qed

	lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_F

	lemma (in cf_parallel) the_cf_parallel_ArrMap_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>"
	proof-
	from assms have "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
	from this show ?thesis
	using cat_parallel_ineq
	by (elim the_cat_parallel_ArrE; simp only: assms)
	(auto simp: the_cf_parallel_ArrMap_app)
	qed

	lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_\<aa>

	lemma (in cf_parallel) the_cf_parallel_ArrMap_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>"
	proof-
	from assms have "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
	from this show ?thesis
	using cat_parallel_ineq
	by (elim the_cat_parallel_ArrE; simp only: assms)
	(auto simp: the_cf_parallel_ArrMap_app)
	qed

	lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_\<bb>

	lemma (in cf_parallel) the_cf_parallel_ArrMap_vrange:
	"\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>) = (F' `\<^sub>\<circ> F) \<union>\<^sub>\<circ> set {\<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>}"
	(is \<open>\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>) = ?FF \<union>\<^sub>\<circ> ?CID\<close>)
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> ?FF \<union>\<^sub>\<circ> ?CID"
	proof
	(
	intro vsv.vsv_vrange_vsubset the_cf_parallel_ArrMap_vsv,
	unfold the_cf_parallel_ArrMap_vdomain
	)
	fix f assume prems: "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	from prems show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> ?FF \<union>\<^sub>\<circ> ?CID"
	by (elim the_cat_parallel_ArrE; (simp only:)?)
	(
	cs_concl
	cs_simp: vinsert_set_insert_eq cat_parallel_cs_simps
	cs_intro: vsv.vsv_vimageI1 V_cs_intros
	)
	qed

	show "?FF \<union>\<^sub>\<circ> ?CID \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	proof(rule vsubsetI)
	fix f assume prems: "f \<in>\<^sub>\<circ> F' `\<^sub>\<circ> F \<union>\<^sub>\<circ> set {\<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>}"
	then consider \<open>f \<in>\<^sub>\<circ> F' `\<^sub>\<circ> F\<close> \| \<open>f = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>\<close> \| \<open>f = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>\<close> by auto
	then show "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	proof cases
	assume "f \<in>\<^sub>\<circ> F' `\<^sub>\<circ> F"
	then obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" and f_def: "f = F'\<lparr>\<ff>\<rparr>" by auto
	from \<ff> have f_def': "f = \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>\<ff>\<rparr>"
	unfolding f_def by (cs_concl cs_simp: cat_parallel_cs_simps)
	from \<ff> have "\<ff> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)
	then show "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	unfolding f_def'
	by (auto simp: cat_parallel_cs_intros intro: vsv.vsv_vimageI2)
	next
	assume prems: "f = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>"
	have f_def': "f = \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>\<aa>\<rparr>"
	by (cs_concl cs_simp: cat_parallel_cs_simps prems)
	have "\<aa> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)
	then show "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	unfolding f_def'
	by (auto simp: cat_parallel_cs_intros intro: vsv.vsv_vimageI2)
	next
	assume prems: "f = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>"
	have f_def': "f = \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>\<bb>\<rparr>"
	by (cs_concl cs_shallow cs_simp: V_cs_simps cat_parallel_cs_simps prems)
	have "\<bb> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
	)
	then show "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	unfolding f_def'
	by (auto simp: cat_parallel_cs_intros intro: vsv.vsv_vimageI2)
	qed
	qed

	qed

	lemma (in cf_parallel) the_cf_parallel_ArrMap_vrange_vsubset_Arr:
	"\<R>\<^sub>\<circ> (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof(intro vsv.vsv_vrange_vsubset, unfold cat_parallel_cs_simps)
	show "vsv (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>)"
	by (cs_intro_step cat_parallel_cs_intros)
	fix f assume "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	then show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by (elim the_cat_parallel_ArrE)
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps
	cs_intro: cat_cs_intros cat_parallel_cs_intros
	)+
	qed


	subsubsection\<open>Parallel functor is a functor\<close>

	lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor:
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F' : \<Up>\<^sub>C \<aa> \<bb> F \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_tm_functorI' is_functorI')

	interpret tcp: tiny_category \<alpha> \<open>\<Up>\<^sub>C \<aa> \<bb> F\<close>
	by (rule tiny_category_the_cat_parallel)

	show "vfsequence (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F')"
	unfolding the_cf_parallel_def by auto
	show "vcard (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F') = 4\<^sub>\<nat>"
	unfolding the_cf_parallel_def by (simp add: nat_omega_simps)
	show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b" for a b f
	using that
	by (cases rule: the_cat_parallel_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps
	cs_intro: cat_cs_intros cat_parallel_cs_intros
	)+

	show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> f\<rparr> =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> c" and "f : a \<mapsto>\<^bsub>\<Up>\<^sub>C \<aa> \<bb> F\<^esub> b" for b c g a f
	using that
	by (elim the_cat_parallel_is_arrE) (very slow)
	(
	all\<open>simp only:\<close>,
	all\<open>
	solves\<open>simp add: cat_parallel_ineq cat_parallel_\<aa>\<bb>[symmetric]\<close> \|
	cs_concl
	cs_simp: cat_cs_simps cat_parallel_cs_simps
	cs_intro: cat_cs_intros cat_parallel_cs_intros
	\<close>
	)

	show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>\<Up>\<^sub>C \<aa> \<bb> F\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<CC>\<lparr>CId\<rparr>\<lparr>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>" for c
	using that
	by (elim the_cat_parallel_ObjE; simp only:)
	(cs_concl cs_simp: cat_parallel_cs_simps)+

	show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof
	(
	rule vbrelation.vbrelation_Limit_in_VsetI,
	unfold
	the_cf_parallel_ObjMap_vdomain
	the_cf_parallel_ObjMap_vrange
	the_cat_parallel_components(1);
	(intro Limit_vdoubleton_in_VsetI)?
	)
	show "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb> \<in>\<^sub>\<circ> Vset \<alpha>" "\<aa>' \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb>' \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros cat_parallel_cs_intros)+
	qed (use the_cf_parallel_ObjMap_vsv in blast)+

	show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof
	(
	rule vbrelation.vbrelation_Limit_in_VsetI,
	unfold
	the_cf_parallel_ArrMap_vdomain
	the_cf_parallel_ArrMap_vrange
	the_cat_parallel_components(1);
	(intro tcp.tiny_cat_Arr_in_Vset vunion_in_VsetI Limit_vdoubleton_in_VsetI)?
	)
	show "\<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" "\<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros cat_parallel_cs_intros)+
	from cf_parallel_F' have "F' `\<^sub>\<circ> F \<subseteq>\<^sub>\<circ> Hom \<CC> \<aa>' \<bb>'"
	by (simp add: F'.vsv_vimage_vsubsetI)
	moreover have "Hom \<CC> \<aa>' \<bb>' \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: cat_Hom_in_Vset cf_parallel_\<aa>' cf_parallel_\<bb>')
	ultimately show "F' `\<^sub>\<circ> F \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed (use the_cf_parallel_ArrMap_vsv in blast)+

	qed
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps
	cs_intro:
	the_cf_parallel_ObjMap_vrange_vsubset_Obj
	cat_parallel_cs_intros cat_cs_intros cat_small_cs_intros
	)+

	lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor':
	assumes "\<AA>' = \<Up>\<^sub>C \<aa> \<bb> F" and "\<CC>' = \<CC>"
	shows "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule cf_parallel_the_cf_parallel_is_tm_functor)

	lemmas [cat_parallel_cs_intros] =
	cf_parallel.cf_parallel_the_cf_parallel_is_tm_functor'


	subsubsection\<open>Opposite parallel functor\<close>

	lemma (in cf_parallel) cf_parallel_the_cf_parallel_op[cat_op_simps]:
	"op_cf (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F') = \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F'"
	proof-
	interpret \<up>: is_tm_functor \<alpha> \<open>\<Up>\<^sub>C \<aa> \<bb> F\<close> \<CC> \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<close>
	by (rule cf_parallel_the_cf_parallel_is_tm_functor)
	show ?thesis
	proof
	(
	rule cf_eqI[of \<alpha> \<open>\<Up>\<^sub>C \<bb> \<aa> F\<close> \<open>op_cat \<CC>\<close> _ \<open>\<Up>\<^sub>C \<bb> \<aa> F\<close> \<open>op_cat \<CC>\<close>],
	unfold cat_op_simps
	)
	show "op_cf (\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F') : \<Up>\<^sub>C \<bb> \<aa> F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	show "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F' : \<Up>\<^sub>C \<bb> \<aa> F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by
	(
	cs_concl
	cs_intro: cat_op_intros cat_small_cs_intros cat_parallel_cs_intros
	)
	show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr> =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F'\<lparr>ObjMap\<rparr>"
	proof
	(
	rule vsv_eqI;
	(intro cat_parallel_cs_intros)?;
	unfold cat_parallel_cs_simps
	)
	fix a assume "a \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Obj\<rparr>"
	then consider \<open>a = \<aa>\<close> \| \<open>a = \<bb>\<close> by (elim the_cat_parallel_ObjE) simp
	then show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps
	cs_intro: cat_parallel_cs_intros cat_op_intros
	)
	qed (auto simp: the_cat_parallel_components)
	show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr> =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F'\<lparr>ArrMap\<rparr>"
	proof
	(
	rule vsv_eqI;
	(intro cat_parallel_cs_intros)?;
	unfold cat_parallel_cs_simps
	)
	fix f assume "f \<in>\<^sub>\<circ> \<Up>\<^sub>C \<aa> \<bb> F\<lparr>Arr\<rparr>"
	then consider \<open>f = \<aa>\<close> \| \<open>f = \<bb>\<close> \| \<open>f \<in>\<^sub>\<circ> F\<close>
	by (elim the_cat_parallel_ArrE) simp
	then show
	"\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> F \<aa>' \<bb>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> F \<bb>' \<aa>' F'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_parallel_cs_simps cat_op_simps
	cs_intro: cat_parallel_cs_intros cat_op_intros
	)+
	qed (auto simp: the_cat_parallel_components)
	qed simp_all
	qed

	lemmas [cat_op_simps] = cf_parallel.cf_parallel_the_cf_parallel_op



	subsection\<open>
	Background for the definition of a category with two parallel arrows
	between two objects
	\<close>


	text\<open>
	The case of two parallel arrows between two objects is treated explicitly
	because it is prevalent in applications.
	\<close>

	definition \<gg>\<^sub>P\<^sub>L :: V where "\<gg>\<^sub>P\<^sub>L = 0"
	definition \<ff>\<^sub>P\<^sub>L :: V where "\<ff>\<^sub>P\<^sub>L = 1\<^sub>\<nat>"

	definition \<aa>\<^sub>P\<^sub>L\<^sub>2 :: V where "\<aa>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L (set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L})"
	definition \<bb>\<^sub>P\<^sub>L\<^sub>2 :: V where "\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<bb>\<^sub>P\<^sub>L (set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L})"

	lemma cat_PL2_ineq:
	shows cat_PL2_\<aa>\<bb>[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<noteq> \<bb>\<^sub>P\<^sub>L\<^sub>2"
	and cat_PL2_\<aa>\<gg>[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<noteq> \<gg>\<^sub>P\<^sub>L"
	and cat_PL2_\<aa>\<ff>[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<noteq> \<ff>\<^sub>P\<^sub>L"
	and cat_PL2_\<bb>\<gg>[cat_parallel_cs_intros]: "\<bb>\<^sub>P\<^sub>L\<^sub>2 \<noteq> \<gg>\<^sub>P\<^sub>L"
	and cat_PL2_\<bb>\<ff>[cat_parallel_cs_intros]: "\<bb>\<^sub>P\<^sub>L\<^sub>2 \<noteq> \<ff>\<^sub>P\<^sub>L"
	and cat_PL2_\<gg>\<ff>[cat_parallel_cs_intros]: "\<gg>\<^sub>P\<^sub>L \<noteq> \<ff>\<^sub>P\<^sub>L"
	unfolding \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def \<gg>\<^sub>P\<^sub>L_def \<ff>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L_def \<bb>\<^sub>P\<^sub>L_def
	by (simp_all add: Set.doubleton_eq_iff one)

	lemma (in \<Z>)
	shows cat_PL2_\<aa>[cat_parallel_cs_intros]: "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_PL2_\<bb>[cat_parallel_cs_intros]: "\<bb>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_PL2_\<gg>[cat_parallel_cs_intros]: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_PL2_\<ff>[cat_parallel_cs_intros]: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding \<aa>\<^sub>P\<^sub>L_def \<bb>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def \<gg>\<^sub>P\<^sub>L_def \<ff>\<^sub>P\<^sub>L_def
	by (simp_all add: Limit_vdoubleton_in_VsetI)



	subsection\<open>
	Local assumptions for a category with two parallel arrows between two objects
	\<close>

	locale cat_parallel_2 = \<Z> \<alpha> for \<alpha> +
	fixes \<aa> \<bb> \<gg> \<ff>
	assumes cat_parallel_2_\<aa>\<bb>[cat_parallel_cs_intros]: "\<aa> \<noteq> \<bb>"
	and cat_parallel_2_\<aa>\<gg>[cat_parallel_cs_intros]: "\<aa> \<noteq> \<gg>"
	and cat_parallel_2_\<aa>\<ff>[cat_parallel_cs_intros]: "\<aa> \<noteq> \<ff>"
	and cat_parallel_2_\<bb>\<gg>[cat_parallel_cs_intros]: "\<bb> \<noteq> \<gg>"
	and cat_parallel_2_\<bb>\<ff>[cat_parallel_cs_intros]: "\<bb> \<noteq> \<ff>"
	and cat_parallel_2_\<gg>\<ff>[cat_parallel_cs_intros]: "\<gg> \<noteq> \<ff>"
	and cat_parallel_2_\<aa>_in_Vset[cat_parallel_cs_intros]: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_parallel_2_\<bb>_in_Vset[cat_parallel_cs_intros]: "\<bb> \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_parallel_2_\<gg>_in_Vset[cat_parallel_cs_intros]: "\<gg> \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_parallel_2_\<ff>_in_Vset[cat_parallel_cs_intros]: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"

	lemmas (in cat_parallel_2) cat_parallel_ineq =
	cat_parallel_2_\<aa>\<bb>
	cat_parallel_2_\<aa>\<gg>
	cat_parallel_2_\<aa>\<ff>
	cat_parallel_2_\<bb>\<gg>
	cat_parallel_2_\<bb>\<ff>
	cat_parallel_2_\<gg>\<ff>


	text\<open>Rules.\<close>

	lemmas (in cat_parallel_2) [cat_parallel_cs_intros] = cat_parallel_2_axioms

	mk_ide rf cat_parallel_2_def[unfolded cat_parallel_2_axioms_def]
	\|intro cat_parallel_2I\|
	\|dest cat_parallel_2D[dest]\|
	\|elim cat_parallel_2E[elim]\|

	sublocale cat_parallel_2 \<subseteq> cat_parallel \<alpha> \<aa> \<bb> \<open>set {\<gg>, \<ff>}\<close>
	by unfold_locales
	(simp_all add: cat_parallel_cs_intros Limit_vdoubleton_in_VsetI)


	text\<open>Duality.\<close>

	lemma (in cat_parallel_2) cat_parallel_op[cat_op_intros]:
	"cat_parallel_2 \<alpha> \<bb> \<aa> \<ff> \<gg>"
	by (intro cat_parallel_2I)
	(auto intro!: cat_parallel_cs_intros cat_parallel_ineq[symmetric])



	subsection\<open>\<open>\<up>\<up>\<close>: category with two parallel arrows between two objects\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-2 and Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	definition the_cat_parallel_2 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>\<up>\<up>\<^sub>C\<close>)
	where "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff> = \<Up>\<^sub>C \<aa> \<bb> (set {\<gg>, \<ff>})"


	text\<open>Components.\<close>

	lemma the_cat_parallel_2_components:
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Obj\<rparr> = set {\<aa>, \<bb>}"
	and "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr> = set {\<aa>, \<bb>, \<gg>, \<ff>}"
	unfolding the_cat_parallel_2_def the_cat_parallel_components by auto


	text\<open>Elementary properties.\<close>

	lemma the_cat_parallel_2_commute: "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff> = \<up>\<up>\<^sub>C \<aa> \<bb> \<ff> \<gg>"
	unfolding the_cat_parallel_2_def by (simp add: insert_commute)

	lemma cat_parallel_is_cat_parallel_2:
	assumes "cat_parallel \<alpha> \<aa> \<bb> (set {\<gg>, \<ff>})" and "\<gg> \<noteq> \<ff>"
	shows "cat_parallel_2 \<alpha> \<aa> \<bb> \<gg> \<ff>"
	proof-
	interpret cat_parallel \<alpha> \<aa> \<bb> \<open>set {\<gg>, \<ff>}\<close> by (rule assms(1))
	show ?thesis
	using cat_parallel_\<aa>F cat_parallel_\<bb>F cat_parallel_F_in_Vset assms
	by (intro cat_parallel_2I)
	(
	auto
	dest: vdoubleton_in_VsetD
	simp: cat_parallel_\<aa>_in_Vset cat_parallel_\<bb>_in_Vset
	)
	qed


	subsubsection\<open>Objects\<close>

	lemma the_cat_parallel_2_Obj_\<aa>I[cat_parallel_cs_intros]:
	assumes "a = \<aa>"
	shows "a \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Obj\<rparr>"
	unfolding the_cat_parallel_2_def
	by (cs_concl cs_simp: assms cs_intro: cat_parallel_cs_intros)

	lemma the_cat_parallel_2_Obj_\<bb>I[cat_parallel_cs_intros]:
	assumes "a = \<bb>"
	shows "a \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Obj\<rparr>"
	unfolding the_cat_parallel_2_def
	by (cs_concl cs_shallow cs_simp: assms cs_intro: cat_parallel_cs_intros)

	lemma the_cat_parallel_2_ObjE:
	assumes "a \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Obj\<rparr>"
	obtains "a = \<aa>" \| "a = \<bb>"
	using assms unfolding the_cat_parallel_2_def by (elim the_cat_parallel_ObjE)


	subsubsection\<open>Arrows\<close>

	lemma the_cat_parallel_2_Arr_\<aa>I[cat_parallel_cs_intros]:
	assumes "f = \<aa>"
	shows "f \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_parallel_2_def by (intro the_cat_parallel_Arr_\<aa>I)

	lemma the_cat_parallel_2_Arr_\<bb>I[cat_parallel_cs_intros]:
	assumes "f = \<bb>"
	shows "f \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_parallel_2_def by (intro the_cat_parallel_Arr_\<bb>I)

	lemma the_cat_parallel_2_Arr_\<gg>I[cat_parallel_cs_intros]:
	assumes "f = \<gg>"
	shows "f \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr>"
	unfolding assms(1) the_cat_parallel_2_def
	by (cs_concl cs_simp: V_cs_simps cs_intro: V_cs_intros cat_parallel_cs_intros)

	lemma the_cat_parallel_2_Arr_\<ff>I[cat_parallel_cs_intros]:
	assumes "f = \<ff>"
	shows "f \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr>"
	unfolding assms(1) the_cat_parallel_2_def
	by
	(
	cs_concl cs_shallow
	cs_simp: V_cs_simps cs_intro: V_cs_intros cat_parallel_cs_intros
	)

	lemma the_cat_parallel_2_ArrE:
	assumes "f \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Arr\<rparr>"
	obtains "f = \<aa>" \| "f = \<bb>" \| "f = \<gg>" \| "f = \<ff>"
	using assms that
	unfolding the_cat_parallel_2_def
	by (auto elim!: the_cat_parallel_ArrE)


	subsubsection\<open>Domain\<close>

	lemma the_cat_parallel_2_Dom_vsv[cat_parallel_cs_intros]: "vsv (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>)"
	unfolding the_cat_parallel_2_def by (rule the_cat_parallel_Dom_vsv)

	lemma the_cat_parallel_2_Dom_vdomain[cat_parallel_cs_simps]:
	"\<D>\<^sub>\<circ> (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>) = set {\<aa>, \<bb>, \<gg>, \<ff>}"
	unfolding the_cat_parallel_2_def the_cat_parallel_Dom_vdomain by auto

	lemma (in cat_parallel_2) the_cat_parallel_2_Dom_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<bb>"
	using assms
	unfolding the_cat_parallel_2_def
	by (simp add: the_cat_parallel_Dom_app_\<bb>)

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Dom_app_\<bb>

	lemma (in cat_parallel_2) the_cat_parallel_2_Dom_app_\<gg>[cat_parallel_cs_simps]:
	assumes "f = \<gg>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>"
	using assms
	unfolding the_cat_parallel_2_def
	by (intro the_cat_parallel_Dom_app_F) simp

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Dom_app_\<gg>

	lemma (in cat_parallel_2) the_cat_parallel_2_Dom_app_\<ff>[cat_parallel_cs_simps]:
	assumes "f = \<ff>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>"
	using assms
	unfolding the_cat_parallel_2_def
	by (intro the_cat_parallel_Dom_app_F) simp

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Dom_app_\<ff>

	lemma (in cat_parallel_2) the_cat_parallel_2_Dom_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>"
	using assms
	unfolding the_cat_parallel_2_def
	by (simp add: the_cat_parallel_Dom_app_\<aa>)

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Dom_app_\<aa>


	subsubsection\<open>Codomain\<close>

	lemma the_cat_parallel_2_Cod_vsv[cat_parallel_cs_intros]: "vsv (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>)"
	unfolding the_cat_parallel_2_def by (rule the_cat_parallel_Cod_vsv)

	lemma the_cat_parallel_2_Cod_vdomain[cat_parallel_cs_simps]:
	"\<D>\<^sub>\<circ> (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>) = set {\<aa>, \<bb>, \<gg>, \<ff>}"
	unfolding the_cat_parallel_2_def the_cat_parallel_Cod_vdomain by auto

	lemma (in cat_parallel_2) the_cat_parallel_2_Cod_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	using assms
	unfolding the_cat_parallel_2_def
	by (simp add: the_cat_parallel_Cod_app_\<bb>)

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Cod_app_\<bb>

	lemma (in cat_parallel_2) the_cat_parallel_2_Cod_app_\<gg>[cat_parallel_cs_simps]:
	assumes "f = \<gg>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	using assms
	unfolding the_cat_parallel_2_def
	by (intro the_cat_parallel_Cod_app_F) simp

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Cod_app_\<gg>

	lemma (in cat_parallel_2) the_cat_parallel_2_Cod_app_\<ff>[cat_parallel_cs_simps]:
	assumes "f = \<ff>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>"
	using assms
	unfolding the_cat_parallel_2_def
	by (intro the_cat_parallel_Cod_app_F) simp

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Cod_app_\<ff>

	lemma (in cat_parallel_2) the_cat_parallel_2_Cod_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<aa>"
	using assms
	unfolding the_cat_parallel_2_def
	by (simp add: the_cat_parallel_Cod_app_\<aa>)

	lemmas [cat_parallel_cs_simps] = cat_parallel_2.the_cat_parallel_2_Cod_app_\<aa>


	subsubsection\<open>Composition\<close>

	lemma the_cat_parallel_2_Comp_vsv[cat_parallel_cs_intros]:
	"vsv (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Comp\<rparr>)"
	unfolding the_cat_parallel_2_def by (rule the_cat_parallel_Comp_vsv)

	lemma the_cat_parallel_2_Comp_app_\<bb>\<bb>[cat_parallel_cs_simps]:
	assumes "g = \<bb>" and "f = \<bb>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	proof-
	note gf = the_cat_parallel_Comp_app_\<bb>\<bb>[OF assms, where F=\<open>set {\<gg>, \<ff>}\<close>]
	show "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	unfolding the_cat_parallel_2_def
	subgoal unfolding gf(1) by simp
	subgoal unfolding gf(2) by simp
	done
	qed

	lemma the_cat_parallel_2_Comp_app_\<aa>\<aa>[cat_parallel_cs_simps]:
	assumes "g = \<aa>" and "f = \<aa>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	proof-
	note gf = the_cat_parallel_Comp_app_\<aa>\<aa>[OF assms, where F=\<open>set {\<gg>, \<ff>}\<close>]
	show "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	unfolding the_cat_parallel_2_def
	subgoal unfolding gf(1) by simp
	subgoal unfolding gf(2) by simp
	done
	qed

	lemma the_cat_parallel_2_Comp_app_\<bb>\<gg>[cat_parallel_cs_simps]:
	assumes "g = \<bb>" and "f = \<gg>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	unfolding
	the_cat_parallel_2_def assms
	the_cat_parallel_Comp_app_\<bb>F[
	where F=\<open>set {\<gg>, \<ff>}\<close>, OF assms(1), of \<gg>, unfolded assms, simplified
	]
	by simp

	lemma the_cat_parallel_2_Comp_app_\<bb>\<ff>[cat_parallel_cs_simps]:
	assumes "g = \<bb>" and "f = \<ff>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = f"
	unfolding
	the_cat_parallel_2_def assms
	the_cat_parallel_Comp_app_\<bb>F[
	where F=\<open>set {\<gg>, \<ff>}\<close>, OF assms(1), of \<ff>, unfolded assms, simplified
	]
	by simp

	lemma (in cat_parallel_2) the_cat_parallel_2_Comp_app_\<gg>\<aa>[cat_parallel_cs_simps]:
	assumes "g = \<gg>" and "f = \<aa>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g"
	unfolding
	the_cat_parallel_2_def assms
	the_cat_parallel_Comp_app_F\<aa>[
	of \<gg>, OF _ assms(2), unfolded assms, simplified
	]
	by simp

	lemma (in cat_parallel_2) the_cat_parallel_2_Comp_app_\<ff>\<aa>[cat_parallel_cs_simps]:
	assumes "g = \<ff>" and "f = \<aa>"
	shows "g \<circ>\<^sub>A\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> f = g"
	unfolding
	the_cat_parallel_2_def assms
	the_cat_parallel_Comp_app_F\<aa>[
	of \<ff>, OF _ assms(2), unfolded assms, simplified
	]
	by simp


	subsubsection\<open>Identity\<close>

	lemma the_cat_parallel_2_CId_vsv[cat_parallel_cs_intros]: "vsv (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>CId\<rparr>)"
	unfolding the_cat_parallel_2_def by (rule the_cat_parallel_CId_vsv)

	lemma the_cat_parallel_2_CId_vdomain[cat_parallel_cs_simps]:
	"\<D>\<^sub>\<circ> (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>CId\<rparr>) = set {\<aa>, \<bb>}"
	unfolding the_cat_parallel_2_def by (rule the_cat_parallel_CId_vdomain)

	lemma the_cat_parallel_2_CId_app_\<aa>[cat_parallel_cs_simps]:
	assumes "a = \<aa>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<aa>"
	unfolding assms the_cat_parallel_2_def
	by (simp add: the_cat_parallel_CId_app_\<aa>)

	lemma the_cat_parallel_2_CId_app_\<bb>[cat_parallel_cs_simps]:
	assumes "a = \<bb>"
	shows "\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<bb>"
	unfolding assms the_cat_parallel_2_def
	by (simp add: the_cat_parallel_CId_app_\<bb>)


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma (in cat_parallel_2) the_cat_parallel_2_is_arr_\<aa>\<aa>\<aa>[cat_parallel_cs_intros]:
	assumes "a' = \<aa>" and "b' = \<aa>" and "f = \<aa>"
	shows "f : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> b'"
	unfolding assms the_cat_parallel_2_def
	by (simp add: the_cat_parallel_is_arr_\<aa>\<aa>\<aa>)

	lemma (in cat_parallel_2) the_cat_parallel_2_is_arr_\<bb>\<bb>\<bb>[cat_parallel_cs_intros]:
	assumes "a' = \<bb>" and "b' = \<bb>" and "f = \<bb>"
	shows "f : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> b'"
	unfolding assms the_cat_parallel_2_def
	by (simp add: the_cat_parallel_is_arr_\<bb>\<bb>\<bb>)

	lemma (in cat_parallel_2) the_cat_parallel_2_is_arr_\<aa>\<bb>\<gg>[cat_parallel_cs_intros]:
	assumes "a' = \<aa>" and "b' = \<bb>" and "f = \<gg>"
	shows "f : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> b'"
	unfolding assms the_cat_parallel_2_def
	by
	(
	rule the_cat_parallel_is_arr_\<aa>\<bb>F[
	OF assms(1,2), of \<gg>, unfolded assms, simplified
	]
	)

	lemma (in cat_parallel_2) the_cat_parallel_2_is_arr_\<aa>\<bb>\<ff>[cat_parallel_cs_intros]:
	assumes "a' = \<aa>" and "b' = \<bb>" and "f = \<ff>"
	shows "f : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> b'"
	unfolding assms the_cat_parallel_2_def
	by
	(
	rule the_cat_parallel_is_arr_\<aa>\<bb>F[
	OF assms(1,2), of \<ff>, unfolded assms, simplified
	]
	)

	lemma (in cat_parallel_2) the_cat_parallel_2_is_arrE:
	assumes "f' : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<^esub> b'"
	obtains "a' = \<aa>" and "b' = \<aa>" and "f' = \<aa>"
	\| "a' = \<bb>" and "b' = \<bb>" and "f' = \<bb>"
	\| "a' = \<aa>" and "b' = \<bb>" and "f' = \<gg>"
	\| "a' = \<aa>" and "b' = \<bb>" and "f' = \<ff>"
	using assms
	unfolding the_cat_parallel_2_def
	by (elim the_cat_parallel_is_arrE) auto


	subsubsection\<open>\<open>\<up>\<up>\<close> is a category\<close>

	lemma (in cat_parallel_2)
	finite_category_the_cat_parallel_2[cat_parallel_cs_intros]:
	"finite_category \<alpha> (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>)"
	proof(intro finite_categoryI'' )
	show "tiny_category \<alpha> (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>)"
	unfolding the_cat_parallel_2_def by (rule tiny_category_the_cat_parallel)
	qed (auto simp: the_cat_parallel_2_components)

	lemmas [cat_parallel_cs_intros] =
	cat_parallel_2.finite_category_the_cat_parallel_2


	subsubsection\<open>Opposite parallel category\<close>

	lemma (in cat_parallel_2) op_cat_the_cat_parallel_2[cat_op_simps]:
	"op_cat (\<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>) = \<up>\<up>\<^sub>C \<bb> \<aa> \<ff> \<gg>"
	unfolding the_cat_parallel_2_def cat_op_simps by (metis doubleton_eq_iff)

	lemmas [cat_op_simps] = cat_parallel_2.op_cat_the_cat_parallel_2



	subsection\<open>
	Parallel functor for a category with two parallel arrows between two objects
	\<close>

	locale cf_parallel_2 = cat_parallel_2 \<alpha> \<aa> \<bb> \<gg> \<ff> + category \<alpha> \<CC>
	for \<alpha> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' \<CC> :: V +
	assumes cf_parallel_\<gg>'[cat_parallel_cs_intros]: "\<gg>' : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"
	and cf_parallel_\<ff>'[cat_parallel_cs_intros]: "\<ff>' : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"

	sublocale cf_parallel_2 \<subseteq>
	cf_parallel \<alpha> \<aa> \<bb> \<open>set {\<gg>, \<ff>}\<close> \<aa>' \<bb>' \<open>\<lambda>f\<in>\<^sub>\<circ>set {\<gg>, \<ff>}. (f = \<ff> ? \<ff>' : \<gg>')\<close> \<CC>
	by unfold_locales (auto intro: cat_parallel_cs_intros cat_cs_intros)

	lemma (in cf_parallel_2) cf_parallel_2_\<gg>''[cat_parallel_cs_intros]:
	assumes "a = \<aa>'" and "b = \<bb>'"
	shows "\<gg>' : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_parallel_\<gg>')

	lemma (in cf_parallel_2) cf_parallel_2_\<gg>'''[cat_parallel_cs_intros]:
	assumes "g = \<gg>'" and "b = \<bb>'"
	shows "g : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_parallel_\<gg>')

	lemma (in cf_parallel_2) cf_parallel_2_\<gg>''''[cat_parallel_cs_intros]:
	assumes "g = \<gg>'" and "a = \<aa>'"
	shows "g : a \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"
	unfolding assms by (rule cf_parallel_\<gg>')

	lemma (in cf_parallel_2) cf_parallel_2_\<ff>''[cat_parallel_cs_intros]:
	assumes "a = \<aa>'" and "b = \<bb>'"
	shows "\<ff>' : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_parallel_\<ff>')

	lemma (in cf_parallel_2) cf_parallel_2_\<ff>'''[cat_parallel_cs_intros]:
	assumes "f = \<ff>'" and "b = \<bb>'"
	shows "f : \<aa>' \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_parallel_\<ff>')

	lemma (in cf_parallel_2) cf_parallel_2_\<ff>''''[cat_parallel_cs_intros]:
	assumes "f = \<ff>'" and "a = \<aa>'"
	shows "f : a \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>'"
	unfolding assms by (rule cf_parallel_\<ff>')


	text\<open>Rules.\<close>

	lemma (in cf_parallel_2) cf_parallel_axioms'[cat_parallel_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "a = \<aa>"
	and "b = \<bb>"
	and "g = \<gg>"
	and "f = \<ff>"
	and "a' = \<aa>'"
	and "b' = \<bb>'"
	and "g' = \<gg>'"
	and "f' = \<ff>'"
	shows "cf_parallel_2 \<alpha>' a b g f a' b' g' f' \<CC>"
	unfolding assms by (rule cf_parallel_2_axioms)

	mk_ide rf cf_parallel_2_def[unfolded cf_parallel_2_axioms_def]
	\|intro cf_parallel_2I\|
	\|dest cf_parallel_2D[dest]\|
	\|elim cf_parallel_2E[elim]\|

	lemmas [cat_parallel_cs_intros] = cf_parallelD(1,2)


	text\<open>Duality.\<close>

	lemma (in cf_parallel_2) cf_parallel_2_op[cat_op_intros]:
	"cf_parallel_2 \<alpha> \<bb> \<aa> \<ff> \<gg> \<bb>' \<aa>' \<ff>' \<gg>' (op_cat \<CC>)"
	by (intro cf_parallel_2I, unfold cat_op_simps)
	(cs_concl cs_intro: cat_parallel_cs_intros cat_cs_intros cat_op_intros)

	lemmas [cat_op_intros] = cf_parallel.cf_parallel_op


	subsubsection\<open>Definition and elementary properties\<close>

	definition the_cf_parallel_2 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F\<close>)
	where "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' =
	\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> (set {\<gg>, \<ff>}) \<aa>' \<bb>' (\<lambda>f\<in>\<^sub>\<circ>set {\<gg>, \<ff>}. (f = \<ff> ? \<ff>' : \<gg>'))"


	text\<open>Components.\<close>

	lemma the_cf_parallel_2_components:
	shows [cat_parallel_cs_simps]:
	"\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>HomDom\<rparr> = \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>"
	and [cat_parallel_cs_simps]:
	"\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>HomCod\<rparr> = \<CC>"
	unfolding
	the_cf_parallel_2_def the_cat_parallel_2_def the_cf_parallel_components
	by simp_all


	text\<open>Elementary properties.\<close>

	lemma (in cf_parallel_2) cf_parallel_2_the_cf_parallel_2_commute:
	"\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' = \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<ff> \<gg> \<aa>' \<bb>' \<ff>' \<gg>'"
	using cat_parallel_2_\<gg>\<ff>
	unfolding the_cf_parallel_2_def insert_commute
	by (force simp: VLambda_vdoubleton)

	lemma cf_parallel_is_cf_parallel_2:
	assumes
	"cf_parallel \<alpha> \<aa> \<bb> (set {\<gg>, \<ff>}) \<aa>' \<bb>' (\<lambda>f\<in>\<^sub>\<circ>set {\<gg>, \<ff>}. (f = \<ff> ? \<ff>' : \<gg>')) \<CC>"
	and "\<gg> \<noteq> \<ff>"
	shows "cf_parallel_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' \<CC>"
	proof-
	interpret
	cf_parallel \<alpha> \<aa> \<bb> \<open>set {\<gg>, \<ff>}\<close> \<aa>' \<bb>' \<open>\<lambda>f\<in>\<^sub>\<circ>set {\<gg>, \<ff>}. (f = \<ff> ? \<ff>' : \<gg>')\<close> \<CC>
	by (rule assms(1))
	have \<gg>\<ff>: "\<gg> \<in>\<^sub>\<circ> set {\<gg>, \<ff>}" "\<ff> \<in>\<^sub>\<circ> set {\<gg>, \<ff>}" by auto
	show ?thesis
	using cat_parallel_axioms assms(2) category_axioms \<gg>\<ff>[THEN cf_parallel_F']
	by (intro cf_parallel_2I cat_parallel_is_cat_parallel_2)
	(auto simp: assms(2))
	qed


	subsubsection\<open>Object map\<close>

	lemma the_cf_parallel_2_ObjMap_vsv[cat_parallel_cs_intros]:
	"vsv (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>)"
	unfolding the_cf_parallel_2_def by (intro cat_parallel_cs_intros)

	lemma the_cf_parallel_2_ObjMap_vdomain[cat_parallel_cs_simps]:
	"\<D>\<^sub>\<circ> (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>) = \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>\<lparr>Obj\<rparr>"
	unfolding the_cf_parallel_2_def
	by (cs_concl cs_shallow cs_simp: cat_parallel_cs_simps the_cat_parallel_2_def)

	lemma (in cf_parallel_2) the_cf_parallel_2_ObjMap_app_\<aa>[cat_parallel_cs_simps]:
	assumes "x = \<aa>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<aa>'"
	unfolding the_cf_parallel_2_def
	by (cs_concl cs_simp: assms cat_parallel_cs_simps)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ObjMap_app_\<aa>

	lemma (in cf_parallel_2) the_cf_parallel_2_ObjMap_app_\<bb>[cat_parallel_cs_simps]:
	assumes "x = \<bb>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<bb>'"
	unfolding the_cf_parallel_2_def
	by (cs_concl cs_shallow cs_simp: assms cat_parallel_cs_simps)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ObjMap_app_\<bb>

	lemma (in cf_parallel_2) the_cf_parallel_2_ObjMap_vrange:
	"\<R>\<^sub>\<circ> (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>) = set {\<aa>', \<bb>'}"
	unfolding the_cf_parallel_2_def by (rule the_cf_parallel_ObjMap_vrange)

	lemma (in cf_parallel_2) the_cf_parallel_2_ObjMap_vrange_vsubset_Obj:
	"\<R>\<^sub>\<circ> (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	unfolding the_cf_parallel_2_def
	by (rule the_cf_parallel_ObjMap_vrange_vsubset_Obj)


	subsubsection\<open>Arrow map\<close>

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_app_\<gg>[cat_parallel_cs_simps]:
	assumes "f = \<gg>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<gg>'"
	unfolding the_cf_parallel_2_def assms
	by
	(
	cs_concl
	cs_simp: V_cs_simps cat_parallel_cs_simps
	cs_intro: V_cs_intros cat_parallel_cs_intros
	)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ArrMap_app_\<gg>

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_app_\<ff>[cat_parallel_cs_simps]:
	assumes "f = \<ff>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<ff>'"
	unfolding the_cf_parallel_2_def assms
	by
	(
	cs_concl
	cs_simp: V_cs_simps cat_parallel_cs_simps
	cs_intro: V_cs_intros cat_parallel_cs_intros
	)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ArrMap_app_\<ff>

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_app_\<aa>[cat_parallel_cs_simps]:
	assumes "f = \<aa>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>"
	unfolding the_cf_parallel_2_def assms
	by (cs_concl cs_simp: cat_parallel_cs_simps)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ArrMap_app_\<aa>

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_app_\<bb>[cat_parallel_cs_simps]:
	assumes "f = \<bb>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>"
	unfolding the_cf_parallel_2_def assms
	by (cs_concl cs_shallow cs_simp: cat_parallel_cs_simps)

	lemmas [cat_parallel_cs_simps] = cf_parallel_2.the_cf_parallel_2_ArrMap_app_\<bb>

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_vrange:
	"\<R>\<^sub>\<circ> (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>) = set {\<CC>\<lparr>CId\<rparr>\<lparr>\<aa>'\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>'\<rparr>, \<ff>', \<gg>'}"
	unfolding the_cf_parallel_2_def the_cf_parallel_ArrMap_vrange
	using cat_parallel_2_\<gg>\<ff>
	by (auto simp: app_vimage_iff VLambda_vdoubleton)

	lemma (in cf_parallel_2) the_cf_parallel_2_ArrMap_vrange_vsubset_Arr:
	"\<R>\<^sub>\<circ> (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>'\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	unfolding the_cf_parallel_2_def
	by (rule the_cf_parallel_ArrMap_vrange_vsubset_Arr)


	subsubsection\<open>
	Parallel functor for a category with two parallel arrows between
	two objects is a functor
	\<close>

	lemma (in cf_parallel_2) cf_parallel_2_the_cf_parallel_2_is_tm_functor:
	"\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' : \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	unfolding the_cf_parallel_2_def the_cat_parallel_2_def
	by (rule cf_parallel_the_cf_parallel_is_tm_functor)

	lemma (in cf_parallel_2) cf_parallel_2_the_cf_parallel_2_is_tm_functor':
	assumes "\<AA>' = \<up>\<up>\<^sub>C \<aa> \<bb> \<gg> \<ff>" and "\<CC>' = \<CC>"
	shows "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule cf_parallel_2_the_cf_parallel_2_is_tm_functor)

	lemmas [cat_parallel_cs_intros] =
	cf_parallel_2.cf_parallel_2_the_cf_parallel_2_is_tm_functor'


	subsubsection\<open>
	Opposite parallel functor for a category with two parallel arrows between
	two objects
	\<close>

	lemma (in cf_parallel_2) cf_parallel_2_the_cf_parallel_2_op[cat_op_simps]:
	"op_cf (\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa> \<bb> \<gg> \<ff> \<aa>' \<bb>' \<gg>' \<ff>') =
	\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F (op_cat \<CC>) \<bb> \<aa> \<ff> \<gg> \<bb>' \<aa>' \<ff>' \<gg>'"
	using cat_parallel_2_\<gg>\<ff>
	unfolding the_cf_parallel_2_def cf_parallel_the_cf_parallel_op
	by (auto simp: VLambda_vdoubleton insert_commute)

	lemmas [cat_op_simps] = cf_parallel_2.cf_parallel_2_the_cf_parallel_2_op

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Rel.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Rel.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Rel.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Rel.thy
	@@ -1,687 +1,668 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Rel\<close>\<close>
	theory CZH_ECAT_Rel
	imports
	CZH_Foundations.CZH_SMC_Rel
	CZH_ECAT_Functor
	CZH_ECAT_Small_Category
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition of \<open>Rel\<close> as a category is analogous
	to the one used in \cite{milehins_category_2021}
	for the exposition of \<open>Rel\<close> as a semicategory.
	The general references for this section are Chapter I-7 in
	\cite{mac_lane_categories_2010} and nLab
	\cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/Rel}
	}.
	\<close>

	named_theorems cat_Rel_cs_simps
	named_theorems cat_Rel_cs_intros

	lemmas (in arr_Rel) [cat_Rel_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Rel) [cat_cs_intros, cat_Rel_cs_intros] =
	+ arr_Rel_axioms'
	+
	lemmas [cat_Rel_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Rel.arr_Rel_length
	arr_Rel_comp_Rel_id_Rel_left
	arr_Rel_comp_Rel_id_Rel_right
	arr_Rel.arr_Rel_converse_Rel_converse_Rel
	arr_Rel_converse_Rel_eq_iff
	arr_Rel_converse_Rel_comp_Rel
	arr_Rel_comp_Rel_converse_Rel_left_if_v11
	arr_Rel_comp_Rel_converse_Rel_right_if_v11

	lemmas [cat_Rel_cs_intros] =
	dg_Rel_shared_cs_intros
	arr_Rel_comp_Rel
	arr_Rel.arr_Rel_converse_Rel

	+lemmas [cat_cs_simps] = incl_Rel_ArrVal_app
	+


	subsection\<open>\<open>Rel\<close> as a category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_Rel :: "V \<Rightarrow> V"
	where "cat_Rel \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Rel \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Rel \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>),
	VLambda (Vset \<alpha>) id_Rel
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_Rel_components:
	shows "cat_Rel \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "cat_Rel \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Rel \<alpha> T}"
	and "cat_Rel \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "cat_Rel \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "cat_Rel \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Rel \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_Rel \<alpha>\<lparr>CId\<rparr> = VLambda (Vset \<alpha>) id_Rel"
	unfolding cat_Rel_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_Rel: "cat_smc (cat_Rel \<alpha>) = smc_Rel \<alpha>"
	proof(rule vsv_eqI)
	show "vsv (cat_smc (cat_Rel \<alpha>))" unfolding cat_smc_def by auto
	show "vsv (smc_Rel \<alpha>)" unfolding smc_Rel_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_Rel \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_Rel \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_Rel \<alpha>)) = \<D>\<^sub>\<circ> (smc_Rel \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show
	"a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_Rel \<alpha>)) \<Longrightarrow> cat_smc (cat_Rel \<alpha>)\<lparr>a\<rparr> = smc_Rel \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_Rel_def smc_Rel_def
	)
	(auto simp: nat_omega_simps)
	qed

	lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps]:
	cat_Rel_Obj_iff = smc_Rel_Obj_iff
	and cat_Rel_Arr_iff[cat_Rel_cs_simps] = smc_Rel_Arr_iff
	and cat_Rel_Dom_vsv[cat_Rel_cs_intros] = smc_Rel_Dom_vsv
	and cat_Rel_Dom_vdomain[cat_Rel_cs_simps] = smc_Rel_Dom_vdomain
	and cat_Rel_Dom_app[cat_Rel_cs_simps] = smc_Rel_Dom_app
	and cat_Rel_Dom_vrange = smc_Rel_Dom_vrange
	and cat_Rel_Cod_vsv[cat_Rel_cs_intros] = smc_Rel_Cod_vsv
	and cat_Rel_Cod_vdomain[cat_Rel_cs_simps] = smc_Rel_Cod_vdomain
	and cat_Rel_Cod_app[cat_Rel_cs_simps] = smc_Rel_Cod_app
	and cat_Rel_Cod_vrange = smc_Rel_Cod_vrange
	and cat_Rel_is_arrI[cat_Rel_cs_intros] = smc_Rel_is_arrI
	and cat_Rel_is_arrD = smc_Rel_is_arrD
	and cat_Rel_is_arrE = smc_Rel_is_arrE
	+ and cat_Rel_is_arr_ArrValE = smc_Rel_is_arr_ArrValE

	lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps, unfolded cat_smc_cat_Rel]:
	cat_Rel_composable_arrs_dg_Rel = smc_Rel_composable_arrs_dg_Rel
	and cat_Rel_Comp = smc_Rel_Comp
	and cat_Rel_Comp_app[cat_Rel_cs_simps] = smc_Rel_Comp_app
	and cat_Rel_Comp_vdomain[simp] = smc_Rel_Comp_vdomain
	+ and cat_Rel_is_monic_arrI = smc_Rel_is_monic_arrI
	+ and cat_Rel_is_monic_arrD = smc_Rel_is_monic_arrD
	+ and cat_Rel_is_monic_arr = smc_Rel_is_monic_arr
	+ and cat_Rel_is_monic_arr_is_epic_arr = smc_Rel_is_monic_arr_is_epic_arr
	+ and cat_Rel_is_epic_arr_is_monic_arr = smc_Rel_is_epic_arr_is_monic_arr
	+ and cat_Rel_is_epic_arrI = smc_Rel_is_epic_arrI
	+ and cat_Rel_is_epic_arrD = smc_Rel_is_epic_arrD
	+ and cat_Rel_is_epic_arr = smc_Rel_is_epic_arr

	lemmas [cat_cs_simps] = cat_Rel_is_arrD(2,3)

	lemmas [cat_Rel_cs_intros] = cat_Rel_is_arrI

	lemmas_with (in \<Z>) [folded cat_smc_cat_Rel, unfolded slicing_simps]:
	cat_Rel_Hom_vifunion_in_Vset = smc_Rel_Hom_vifunion_in_Vset
	and cat_Rel_incl_Rel_is_arr = smc_Rel_incl_Rel_is_arr
	and cat_Rel_incl_Rel_is_arr'[cat_Rel_cs_intros] = smc_Rel_incl_Rel_is_arr'
	- and cat_Rel_is_arr_ArrValE = smc_Rel_is_arr_ArrValE
	- and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange
	- and cat_Rel_is_monic_arrI = smc_Rel_is_monic_arrI
	- and cat_Rel_is_monic_arrD = smc_Rel_is_monic_arrD
	- and cat_Rel_is_monic_arr = smc_Rel_is_monic_arr
	- and cat_Rel_is_monic_arr_is_epic_arr = smc_Rel_is_monic_arr_is_epic_arr
	- and cat_Rel_is_epic_arr_is_monic_arr = smc_Rel_is_epic_arr_is_monic_arr
	- and cat_Rel_is_epic_arrI = smc_Rel_is_epic_arrI
	- and cat_Rel_is_epic_arrD = smc_Rel_is_epic_arrD
	- and cat_Rel_is_epic_arr = smc_Rel_is_epic_arr
	+ and cat_Rel_Comp_vrange = smc_Rel_Comp_vrange
	and cat_Rel_obj_terminal = smc_Rel_obj_terminal
	and cat_Rel_obj_initial = smc_Rel_obj_initial
	and cat_Rel_obj_terminal_obj_initial = smc_Rel_obj_terminal_obj_initial
	and cat_Rel_obj_null = smc_Rel_obj_null
	and cat_Rel_is_zero_arr = smc_Rel_is_zero_arr

	lemmas [cat_Rel_cs_intros] = \<Z>.cat_Rel_incl_Rel_is_arr'


	subsubsection\<open>Identity\<close>

	lemma (in \<Z>) cat_Rel_CId_app[cat_Rel_cs_simps]:
	assumes "T \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>T\<rparr> = id_Rel T"
	using assms unfolding cat_Rel_components by simp

	lemmas [cat_Rel_cs_simps] = \<Z>.cat_Rel_CId_app


	subsubsection\<open>\<open>Rel\<close> is a category\<close>

	lemma (in \<Z>) category_cat_Rel: "category \<alpha> (cat_Rel \<alpha>)"
	proof(rule categoryI, unfold cat_smc_cat_Rel)

	interpret Rel: semicategory \<alpha> \<open>cat_smc (cat_Rel \<alpha>)\<close>
	unfolding cat_smc_cat_Rel by (simp add: semicategory_smc_Rel)

	show "vfsequence (cat_Rel \<alpha>)" unfolding cat_Rel_def by simp
	show "vcard (cat_Rel \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_Rel_def by (simp add: nat_omega_simps)
	show "cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	if "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for A
	using that
	unfolding cat_Rel_Obj_iff
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
	)
	show "cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F = F"
	if "F : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" for F A B
	proof-
	from that have "arr_Rel \<alpha> F" "A \<in>\<^sub>\<circ> Vset \<alpha>" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
	)
	qed

	show "F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> = F"
	if "F : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> C" for F B C
	proof-
	from that have "arr_Rel \<alpha> F" "B \<in>\<^sub>\<circ> Vset \<alpha>" "C \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
	)
	qed

	qed (auto simp: semicategory_smc_Rel cat_Rel_components)

	lemma (in \<Z>) category_cat_Rel'[cat_Rel_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<alpha>'' = \<alpha>"
	shows "category \<alpha>' (cat_Rel \<alpha>'')"
	unfolding assms by (rule category_cat_Rel)

	lemmas [cat_Rel_cs_intros] = \<Z>.category_cat_Rel'



	subsection\<open>Canonical dagger for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_dag_Rel :: "V \<Rightarrow> V" (\<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l\<close>)
	where "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> =
	[
	vid_on (cat_Rel \<alpha>\<lparr>Obj\<rparr>),
	VLambda (cat_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel,
	op_cat (cat_Rel \<alpha>),
	cat_Rel \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_dag_Rel_components:
	shows "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr> = vid_on (cat_Rel \<alpha>\<lparr>Obj\<rparr>)"
	and "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr> = VLambda (cat_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel"
	and "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomDom\<rparr> = op_cat (cat_Rel \<alpha>)"
	and "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomCod\<rparr> = cat_Rel \<alpha>"
	unfolding cf_dag_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_dag_Rel: "cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) = 4\<^sub>\<nat>"
	unfolding cf_smcf_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = 4\<^sub>\<nat>"
	unfolding smcf_dag_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) = \<D>\<^sub>\<circ> (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "A \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) \<Longrightarrow> cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>A\<rparr> = \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>A\<rparr>"
	for A
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold dghm_field_simps[symmetric],
	unfold
	cat_smc_cat_Rel
	slicing_commute[symmetric]
	cf_smcf_components
	smcf_dag_Rel_components
	cf_dag_Rel_components
	smc_Rel_components
	cat_Rel_components
	)
	simp_all
	qed (auto simp: cf_smcf_def smcf_dag_Rel_def)

	lemmas_with [folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps]:
	cf_dag_Rel_ObjMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ObjMap_vsv
	and cf_dag_Rel_ObjMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vdomain
	and cf_dag_Rel_ObjMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_app
	and cf_dag_Rel_ObjMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vrange
	and cf_dag_Rel_ArrMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ArrMap_vsv
	and cf_dag_Rel_ArrMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vdomain
	and cf_dag_Rel_ArrMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_app
	and cf_dag_Rel_ArrMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vrange
	-
	-lemmas_with (in \<Z>) [
	- folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps
	- ]:
	- cf_dag_Rel_app_is_arr[cat_Rel_cs_intros] = smcf_dag_Rel_app_is_arr
	+ and cf_dag_Rel_app_is_arr[cat_Rel_cs_intros] = smcf_dag_Rel_app_is_arr
	and cf_dag_Rel_ArrMap_app_vdomain[cat_cs_simps] =
	smcf_dag_Rel_ArrMap_app_vdomain
	and cf_dag_Rel_ArrMap_app_vrange[cat_cs_simps] =
	smcf_dag_Rel_ArrMap_app_vrange
	and cf_dag_Rel_ArrMap_app_iff[cat_cs_simps] = smcf_dag_Rel_ArrMap_app_iff
	and cf_dag_Rel_ArrMap_smc_Rel_Comp[cat_Rel_cs_simps] =
	smcf_dag_Rel_ArrMap_smc_Rel_Comp

	-lemmas [cat_cs_simps] =
	- \<Z>.cf_dag_Rel_ArrMap_app_vdomain
	- \<Z>.cf_dag_Rel_ArrMap_app_vrange
	- \<Z>.cf_dag_Rel_ArrMap_app_iff
	-

	subsubsection\<open>Canonical dagger is a contravariant isomorphism of \<open>Rel\<close>\<close>

	lemma (in \<Z>) cf_dag_Rel_is_iso_functor:
	"\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_cat (cat_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof
	(
	rule is_iso_functorI,
	unfold
	cat_smc_cat_Rel
	cf_smcf_cf_dag_Rel
	cat_Rel_components
	cat_op_simps
	slicing_commute[symmetric]
	)

	interpret is_iso_semifunctor \<alpha> \<open>op_smc (smc_Rel \<alpha>)\<close> \<open>smc_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	by (rule smcf_dag_Rel_is_iso_semifunctor)
	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)

	show "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_cat (cat_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof
	(
	rule is_functorI,
	unfold
	cat_smc_cat_Rel
	cf_smcf_cf_dag_Rel
	cat_op_simps
	slicing_commute[symmetric]
	cf_dag_Rel_components(3,4)
	)
	show "vfsequence (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)"
	unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
	show "vcard (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = 4\<^sub>\<nat>"
	unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
	show "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
	if "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for C
	proof-
	from that have "C \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto elim: cat_Rel_is_arrE simp: cat_Rel_Obj_iff)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps cs_intro: cat_cs_intros arr_Rel_id_RelI
	)
	qed
	qed (auto simp: cat_cs_intros intro: smc_cs_intros)

	show "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_smc (smc_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	by (rule smcf_dag_Rel_is_iso_semifunctor)

	qed

	lemma (in \<Z>) cf_dag_Rel_is_iso_functor'[cat_cs_intros]:
	assumes "\<AA>' = op_cat (cat_Rel \<alpha>)"
	and "\<BB>' = cat_Rel \<alpha>"
	and "\<alpha>' = \<alpha>"
	shows "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule cf_dag_Rel_is_iso_functor)

	lemmas [cat_cs_intros] = \<Z>.cf_dag_Rel_is_iso_functor'


	subsubsection\<open>Further properties of the canonical dagger\<close>

	lemma (in \<Z>) cf_cn_comp_cf_dag_Rel_cf_dag_Rel:
	"\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> = cf_id (cat_Rel \<alpha>)"
	proof(rule cf_smcf_eqI)
	interpret category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	from cf_dag_Rel_is_iso_functor have dag:
	"\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_cat (cat_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	by (simp add: is_iso_functor.axioms(1))
	from cf_cn_comp_is_functorI[OF category_axioms dag dag] show
	"\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>" .
	show "cf_id (cat_Rel \<alpha>) : cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	by (auto simp: category.cat_cf_id_is_functor category_axioms)
	show "cf_smcf (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = cf_smcf (smcf_id (cat_Rel \<alpha>))"
	unfolding slicing_commute[symmetric] cat_smc_cat_Rel cf_smcf_cf_dag_Rel
	by (simp add: smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel)
	qed simp_all



	subsection\<open>Isomorphism\<close>

	-context \<Z>
	-begin
	-
	context
	begin

	-private lemma cat_Rel_is_arr_isomorphism_right_vsubset:
	+private lemma cat_Rel_is_iso_arr_right_vsubset:
	assumes "S : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	and "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	and "T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	shows "S\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"
	proof(rule vsubset_antisym vsubsetI)

	- interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (simp add: category_cat_Rel)
	-
	interpret S: arr_Rel \<alpha> S
	rewrites "S\<lparr>ArrDom\<rparr> = B" and "S\<lparr>ArrCod\<rparr> = A"
	- using assms(1)
	- by (all\<open>elim Rel.cat_is_arrE\<close>) (simp_all add: cat_Rel_components)
	+ by (intro cat_Rel_is_arrD[OF assms(1)])+
	interpret T: arr_Rel \<alpha> T
	rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	- using assms(2)
	- by (all\<open>elim Rel.cat_is_arrE\<close>) (simp_all add: cat_Rel_components)
	+ by (intro cat_Rel_is_arrD[OF assms(2)])+
	+
	+ interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (simp add: S.category_cat_Rel)
	+
	interpret dag: is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- by (auto simp: cf_dag_Rel_is_iso_functor)
	+ by (auto simp: S.cf_dag_Rel_is_iso_functor)

	from assms(2) have A: "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" by auto
	from assms(3) have "(S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr> = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<lparr>ArrVal\<rparr>"
	by simp
	with A have [simp]: "S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = vid_on A"
	unfolding cat_Rel_Comp_app[OF assms(1,2)]
	by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)

	from assms(2) have B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" by auto
	from assms(4) have "(T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S)\<lparr>ArrVal\<rparr> = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>\<lparr>ArrVal\<rparr>"
	by simp
	with B have [simp]: "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> = vid_on B"
	unfolding cat_Rel_Comp_app[OF assms(2,1)]
	by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)

	fix ab assume ab: "ab \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	with S.vbrelation obtain a b where ab_def: "ab = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> B"
	by (metis S.arr_Rel_ArrVal_vdomain S.ArrVal.vbrelation_vinE vsubsetE)
	then have "\<langle>a, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" by auto
	then obtain c where "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" and ca[intro]: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	by blast
	have "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	proof(rule ccontr)
	assume "\<langle>b, a\<rangle> \<notin>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	with ca have "c \<noteq> b" by clarsimp
	moreover from ab have "\<langle>c, b\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	unfolding ab_def by blast
	ultimately show False by (simp add: vid_on_iff)
	qed
	then show "ab \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>" unfolding ab_def by clarsimp

	qed

	-private lemma cat_Rel_is_arr_isomorphism_left_vsubset:
	+private lemma cat_Rel_is_iso_arr_left_vsubset:
	assumes "S : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	and "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	and "T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	shows "(T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	- using assms(2,3,4) cat_Rel_is_arr_isomorphism_right_vsubset[OF assms(2,1)]
	+ using assms(2,3,4) cat_Rel_is_iso_arr_right_vsubset[OF assms(2,1)]
	by auto

	-private lemma is_arr_isomorphism_dag:
	+private lemma is_iso_arr_dag:
	assumes "S : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	and "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	and "T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	shows "S = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>"
	proof(rule arr_Rel_eqI[of \<alpha>])
	- interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	+
	+ interpret S: arr_Rel \<alpha> S by (intro cat_Rel_is_arrD(1)[OF assms(1)])
	+ interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule S.category_cat_Rel)
	interpret dag: is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- by (auto simp: cf_dag_Rel_is_iso_functor)
	+ by (auto simp: S.cf_dag_Rel_is_iso_functor)
	+
	from assms(1) show S: "arr_Rel \<alpha> S" by (fastforce simp: cat_Rel_components(2))
	from cf_dag_Rel_app_is_arr[OF assms(2)] show "arr_Rel \<alpha> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)"
	by (auto elim!: cat_Rel_is_arrE)
	from assms(2) have T: "arr_Rel \<alpha> T" by (auto simp: cat_Rel_is_arrD(1))
	from S T assms show "S\<lparr>ArrVal\<rparr> = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>"
	unfolding cf_dag_Rel_ArrMap_app[OF T] converse_Rel_components
	by (intro vsubset_antisym)
	(
	simp_all add:
	- cat_Rel_is_arr_isomorphism_left_vsubset
	- cat_Rel_is_arr_isomorphism_right_vsubset
	+ cat_Rel_is_iso_arr_left_vsubset
	+ cat_Rel_is_iso_arr_right_vsubset
	)
	from T assms show "S\<lparr>ArrDom\<rparr> = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrDom\<rparr>"
	unfolding cf_dag_Rel_components
	by (auto simp: cat_cs_simps cat_Rel_cs_simps converse_Rel_components(1))
	from S assms show "S\<lparr>ArrCod\<rparr> = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrCod\<rparr>"
	by
	(
	cs_concl
	cs_intro: cat_op_intros cat_cs_intros
	cs_simp: cat_Rel_cs_simps cat_cs_simps
	)
	+
	qed

	-lemma cat_Rel_is_arr_isomorphismI[intro]:
	+lemma cat_Rel_is_iso_arrI[intro]:
	assumes "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	shows "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	-proof(rule is_arr_isomorphismI[where ?g = \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<close>])
	+proof(rule is_iso_arrI[where ?g = \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<close>])

	- interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	+ interpret T: arr_Rel \<alpha> T by (intro cat_Rel_is_arrD[OF assms(1)])+
	+ interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule T.category_cat_Rel)
	interpret v11: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule assms(2))

	- interpret T: arr_Rel \<alpha> T
	- rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	- using assms(1)
	- by (all\<open>elim cat_Rel_is_arrE\<close>) (simp_all add: cat_Rel_components)
	interpret is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- by (simp add: cf_dag_Rel_is_iso_functor)
	+ by (simp add: T.cf_dag_Rel_is_iso_functor)

	show "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" by (rule assms(1))

	show "is_inverse (cat_Rel \<alpha>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>) T"
	proof(intro is_inverseI)
	from assms(1) show dag_T: "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	by
	(
	cs_concl
	cs_simp: cat_op_simps cat_Rel_cs_simps
	cs_intro: cat_cs_intros
	)
	show T: "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" by (rule assms(1))
	from T T.arr_Rel_axioms v11.v11_axioms assms(3) show
	"\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_cs_intros cat_Rel_cs_intros
	)
	from T T.arr_Rel_axioms v11.v11_axioms assms(4) show
	"T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_cs_intros cat_Rel_cs_intros
	)
	qed

	qed

	-lemma cat_Rel_is_arr_isomorphismD[dest]:
	+lemma cat_Rel_is_iso_arrD[dest]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof-

	from assms show T: "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	- by (simp add: is_arr_isomorphism_def)
	+ by (simp add: is_iso_arr_def)

	interpret T: arr_Rel \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	- using T
	- by (all\<open>elim cat_Rel_is_arrE\<close>) (simp_all add: cat_Rel_components)
	-
	+ by (intro cat_Rel_is_arrD[OF T])+
	interpret is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- by (simp add: cf_dag_Rel_is_iso_functor)
	+ by (simp add: T.cf_dag_Rel_is_iso_functor)

	- from is_arr_isomorphismD[OF assms(1)] obtain S where
	+ from is_iso_arrD[OF assms(1)] obtain S where
	"is_inverse (cat_Rel \<alpha>) S T"
	by clarsimp
	from is_inverseD[OF this] obtain A' B' where "S : B' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A'"
	and "T : A' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'"
	and "S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A'\<rparr>"
	and "T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B'\<rparr>"
	by auto
	moreover with T have "A' = A" "B' = B" by auto
	ultimately have S: "S : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	and ST: "S \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> T = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	and TS: "T \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> S = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	by auto

	from S T ST TS have S_def: "S = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>"
	- by (rule is_arr_isomorphism_dag)
	+ by (rule is_iso_arr_dag)

	interpret S: arr_Rel \<alpha> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<close>
	rewrites "(\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<lparr>ArrDom\<rparr> = B"
	and "(\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<lparr>ArrCod\<rparr> = A"
	by (fold S_def, insert S, all\<open>elim cat_Rel_is_arrE\<close>)
	(simp_all add: cat_Rel_components)

	from T.arr_Rel_axioms S_def have S_T: "S\<lparr>ArrVal\<rparr> = (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"
	by (simp add: cf_dag_Rel_ArrMap_app converse_Rel_components(1))

	from S have A: "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" by auto

	from B TS A ST have
	"(T \<circ>\<^sub>R\<^sub>e\<^sub>l S)\<lparr>ArrVal\<rparr> = id_Rel B\<lparr>ArrVal\<rparr>"
	"(S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr> = id_Rel A\<lparr>ArrVal\<rparr>"
	unfolding cat_Rel_Comp_app[OF S T] cat_Rel_Comp_app[OF T S]
	unfolding cat_Rel_components
	by simp_all

	then have val_ST: "S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = vid_on A"
	and val_TS: "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> = vid_on B"
	unfolding comp_Rel_components id_Rel_components by simp_all

	show "v11 (T\<lparr>ArrVal\<rparr>)"
	proof(rule v11I)

	show "vsv (T\<lparr>ArrVal\<rparr>)"
	proof(rule vsvI)
	fix a b c assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	from prems(1) S_T have "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" by auto
	with prems(2) val_TS have "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> vid_on B" by auto
	then show "b = c" by clarsimp
	qed (auto simp: T.ArrVal.vbrelation_axioms)

	show "vsv ((T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>)"
	proof(rule vsvI)
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"
	with S_T have "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" by auto
	moreover from prems have "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" and "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	by auto
	ultimately have "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> vid_on A" using val_ST by auto
	then show "b = c" by clarsimp
	qed auto

	qed

	show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	proof(intro vsubset_antisym vsubsetI)
	fix a assume "a \<in>\<^sub>\<circ> A"
	with val_ST have "\<langle>a, a\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" by auto
	then show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" by auto
	qed (use T.arr_Rel_ArrVal_vdomain in auto)

	show "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof(intro vsubset_antisym vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> B"
	with val_TS have "\<langle>b, b\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" by auto
	then show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" by auto
	qed (use T.arr_Rel_ArrVal_vrange in auto)

	qed

	end

	-end
	+lemmas [cat_Rel_cs_simps] = cat_Rel_is_iso_arrD(3,4)

	-lemmas [cat_Rel_cs_simps] = \<Z>.cat_Rel_is_arr_isomorphismD(3,4)
	-
	-lemma (in \<Z>) cat_Rel_is_arr_isomorphism:
	+lemma cat_Rel_is_iso_arr:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B \<and>
	v11 (T\<lparr>ArrVal\<rparr>) \<and>
	\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A \<and>
	\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	by auto



	subsection\<open>The inverse arrow\<close>

	-lemma (in \<Z>) cat_Rel_the_inverse:
	+lemma cat_Rel_the_inverse[cat_Rel_cs_simps]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	shows "T\<inverse>\<^sub>C\<^bsub>cat_Rel \<alpha>\<^esub> = T\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	unfolding the_inverse_def
	proof(rule the_equality)
	-
	- interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	from assms have T: "T : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" by auto
	- interpret T: arr_Rel \<alpha> T
	- rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	- using T by (all\<open>elim cat_Rel_is_arrE\<close>) (simp_all add: cat_Rel_components)
	-
	- from assms T T.arr_Rel_axioms cat_Rel_is_arr_isomorphismD(2)[OF assms]
	+ interpret T: arr_Rel \<alpha> T by (intro cat_Rel_is_arrD[OF T])+
	+ interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule T.category_cat_Rel)
	+ from assms T T.arr_Rel_axioms cat_Rel_is_iso_arrD(2)[OF assms]
	show inv_T_T: "is_inverse (cat_Rel \<alpha>) (T\<inverse>\<^sub>R\<^sub>e\<^sub>l) T"
	by (intro is_inverseI[where a=A and b=B])
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_Rel_cs_intros cat_cs_intros
	)+
	-
	- fix S assume prems: "is_inverse (cat_Rel \<alpha>) S T"
	- show "S = T\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	- by (rule category.cat_is_inverse_eq[OF Rel.category_axioms prems inv_T_T])
	-
	+ fix S assume "is_inverse (cat_Rel \<alpha>) S T"
	+ then show "S = T\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	+ by (rule category.cat_is_inverse_eq[OF Rel.category_axioms _ inv_T_T])
	qed

	-lemmas [cat_Rel_cs_simps] = \<Z>.cat_Rel_the_inverse
	-
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SS.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SS.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SS.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SS.thy
	@@ -1,1577 +1,1577 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	-section\<open>\<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>
	+section\<open>\<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>: cospan and span\<close>
	theory CZH_ECAT_SS
	imports CZH_ECAT_Small_Functor
	begin



	subsection\<open>Background\<close>


	text\<open>
	General information about \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close> (also known as
	cospans and spans, respectively) can be found in in Chapters III-3 and III-4
	in \cite{mac_lane_categories_2010}, as well as
	nLab \cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/cospan}
	}\footnote{\url{https://ncatlab.org/nlab/show/span}}.
	\<close>

	named_theorems cat_ss_cs_simps
	named_theorems cat_ss_cs_intros

	named_theorems cat_ss_elem_simps

	definition \<oo>\<^sub>S\<^sub>S where [cat_ss_elem_simps]: "\<oo>\<^sub>S\<^sub>S = 0"
	definition \<aa>\<^sub>S\<^sub>S where [cat_ss_elem_simps]: "\<aa>\<^sub>S\<^sub>S = 1\<^sub>\<nat>"
	definition \<bb>\<^sub>S\<^sub>S where [cat_ss_elem_simps]: "\<bb>\<^sub>S\<^sub>S = 2\<^sub>\<nat>"
	definition \<gg>\<^sub>S\<^sub>S where [cat_ss_elem_simps]: "\<gg>\<^sub>S\<^sub>S = 3\<^sub>\<nat>"
	definition \<ff>\<^sub>S\<^sub>S where [cat_ss_elem_simps]: "\<ff>\<^sub>S\<^sub>S = 4\<^sub>\<nat>"

	lemma cat_ss_ineq:
	shows cat_ss_\<aa>\<bb>[cat_ss_cs_intros]: "\<aa>\<^sub>S\<^sub>S \<noteq> \<bb>\<^sub>S\<^sub>S"
	and cat_ss_\<aa>\<oo>[cat_ss_cs_intros]: "\<aa>\<^sub>S\<^sub>S \<noteq> \<oo>\<^sub>S\<^sub>S"
	and cat_ss_\<bb>\<oo>[cat_ss_cs_intros]: "\<bb>\<^sub>S\<^sub>S \<noteq> \<oo>\<^sub>S\<^sub>S"
	and cat_ss_\<gg>\<ff>[cat_ss_cs_intros]: "\<gg>\<^sub>S\<^sub>S \<noteq> \<ff>\<^sub>S\<^sub>S"
	and cat_ss_\<gg>\<aa>[cat_ss_cs_intros]: "\<gg>\<^sub>S\<^sub>S \<noteq> \<aa>\<^sub>S\<^sub>S"
	and cat_ss_\<gg>\<bb>[cat_ss_cs_intros]: "\<gg>\<^sub>S\<^sub>S \<noteq> \<bb>\<^sub>S\<^sub>S"
	and cat_ss_\<gg>\<oo>[cat_ss_cs_intros]: "\<gg>\<^sub>S\<^sub>S \<noteq> \<oo>\<^sub>S\<^sub>S"
	and cat_ss_\<ff>\<aa>[cat_ss_cs_intros]: "\<ff>\<^sub>S\<^sub>S \<noteq> \<aa>\<^sub>S\<^sub>S"
	and cat_ss_\<ff>\<bb>[cat_ss_cs_intros]: "\<ff>\<^sub>S\<^sub>S \<noteq> \<bb>\<^sub>S\<^sub>S"
	and cat_ss_\<ff>\<oo>[cat_ss_cs_intros]: "\<ff>\<^sub>S\<^sub>S \<noteq> \<oo>\<^sub>S\<^sub>S"
	unfolding cat_ss_elem_simps by simp_all

	lemma (in \<Z>)
	shows cat_ss_\<aa>[cat_ss_cs_intros]: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_ss_\<bb>[cat_ss_cs_intros]: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_ss_\<oo>[cat_ss_cs_intros]: "\<oo>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_ss_\<gg>[cat_ss_cs_intros]: "\<gg>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> Vset \<alpha>"
	and cat_ss_\<ff>[cat_ss_cs_intros]: "\<ff>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding cat_ss_elem_simps by simp_all



	subsection\<open>Composable arrows in \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>

	abbreviation cat_scospan_composable :: V
	where "cat_scospan_composable \<equiv>
	(set {\<oo>\<^sub>S\<^sub>S} \<times>\<^sub>\<bullet> set {\<oo>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S}) \<union>\<^sub>\<circ>
	(set {\<gg>\<^sub>S\<^sub>S, \<aa>\<^sub>S\<^sub>S} \<times>\<^sub>\<bullet> set {\<aa>\<^sub>S\<^sub>S}) \<union>\<^sub>\<circ>
	(set {\<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S} \<times>\<^sub>\<bullet> set {\<bb>\<^sub>S\<^sub>S})"

	abbreviation cat_sspan_composable :: V
	where "cat_sspan_composable \<equiv> (cat_scospan_composable)\<inverse>\<^sub>\<bullet>"


	text\<open>Rules.\<close>

	lemma cat_scospan_composable_\<oo>\<oo>[cat_ss_cs_intros]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<oo>\<gg>[cat_ss_cs_intros]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<oo>\<ff>[cat_ss_cs_intros]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<gg>\<aa>[cat_ss_cs_intros]:
	assumes "g = \<gg>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<ff>\<bb>[cat_ss_cs_intros]:
	assumes "g = \<ff>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<aa>\<aa>[cat_ss_cs_intros]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composable_\<bb>\<bb>[cat_ss_cs_intros]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using assms by auto

	lemma cat_scospan_composableE:
	assumes "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	obtains "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	\| "g = \<oo>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	\| "g = \<oo>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	\| "g = \<gg>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	\| "g = \<ff>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	\| "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	\| "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	using assms that by auto

	lemma cat_sspan_composable_\<oo>\<oo>[cat_ss_cs_intros]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<gg>\<oo>[cat_ss_cs_intros]:
	assumes "g = \<gg>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<ff>\<oo>[cat_ss_cs_intros]:
	assumes "g = \<ff>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<aa>\<gg>[cat_ss_cs_intros]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<bb>\<ff>[cat_ss_cs_intros]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<aa>\<aa>[cat_ss_cs_intros]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composable_\<bb>\<bb>[cat_ss_cs_intros]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	using assms by auto

	lemma cat_sspan_composableE:
	assumes "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable"
	obtains "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	\| "g = \<gg>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	\| "g = \<ff>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	\| "g = \<aa>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	\| "g = \<bb>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	\| "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	\| "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	using assms that by auto



	subsection\<open>Categories \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}.\<close>

	definition the_cat_scospan :: V (\<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close>)
	where "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C =
	[
	set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S},
	set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S},
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| x = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	),
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	),
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_scospan_composable.
	if gf = [\<oo>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<gg>\<^sub>S\<^sub>S
	\| gf = [\<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<ff>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> gf\<lparr>0\<rparr>
	),
	vid_on (set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S})
	]\<^sub>\<circ>"

	definition the_cat_sspan :: V (\<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close>)
	where "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C =
	[
	set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S},
	set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S},
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	),
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| x = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	),
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_sspan_composable.
	if gf = [\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<gg>\<^sub>S\<^sub>S
	\| gf = [\<bb>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<ff>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> gf\<lparr>0\<rparr>
	),
	vid_on (set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S})
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma the_cat_scospan_components:
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr> = set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S}"
	and "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr> = set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}"
	and "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| x = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	)"
	and "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	)"
	and "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Comp\<rparr> =
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_scospan_composable.
	if gf = [\<oo>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<gg>\<^sub>S\<^sub>S
	\| gf = [\<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<ff>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> gf\<lparr>0\<rparr>
	)"
	and "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr> = vid_on (set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S})"
	unfolding the_cat_scospan_def dg_field_simps by (simp_all add: nat_omega_simps)

	lemma the_cat_sspan_components:
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr> = set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S}"
	and "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr> = set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}"
	and "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	)"
	and "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>set {\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S}.
	if x = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| x = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<aa>\<^sub>S\<^sub>S
	\| x = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<bb>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> \<oo>\<^sub>S\<^sub>S
	)"
	and "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Comp\<rparr> =
	(
	\<lambda>gf\<in>\<^sub>\<circ>cat_sspan_composable.
	if gf = [\<aa>\<^sub>S\<^sub>S, \<gg>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<gg>\<^sub>S\<^sub>S
	\| gf = [\<bb>\<^sub>S\<^sub>S, \<ff>\<^sub>S\<^sub>S]\<^sub>\<circ> \<Rightarrow> \<ff>\<^sub>S\<^sub>S
	\| otherwise \<Rightarrow> gf\<lparr>0\<rparr>
	)"
	and "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>CId\<rparr> = vid_on (set {\<aa>\<^sub>S\<^sub>S, \<bb>\<^sub>S\<^sub>S, \<oo>\<^sub>S\<^sub>S})"
	unfolding the_cat_sspan_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Elementary properties.\<close>

	lemma the_cat_scospan_components_vsv[cat_ss_cs_intros]: "vsv (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C)"
	unfolding the_cat_scospan_def by auto

	lemma the_cat_sspan_components_vsv[cat_ss_cs_intros]: "vsv (\<leftarrow>\<bullet>\<rightarrow>\<^sub>C)"
	unfolding the_cat_sspan_def by auto


	subsubsection\<open>Objects\<close>

	lemma the_cat_scospan_Obj_\<oo>I[cat_ss_cs_intros]:
	assumes "a = \<oo>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Obj_\<aa>I[cat_ss_cs_intros]:
	assumes "a = \<aa>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Obj_\<bb>I[cat_ss_cs_intros]:
	assumes "a = \<bb>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_ObjE:
	assumes "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	obtains \<open>a = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close>
	using assms unfolding the_cat_scospan_components by auto

	lemma the_cat_sspan_Obj_\<oo>I[cat_ss_cs_intros]:
	assumes "a = \<oo>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Obj_\<aa>I[cat_ss_cs_intros]:
	assumes "a = \<aa>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Obj_\<bb>I[cat_ss_cs_intros]:
	assumes "a = \<bb>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_ObjE:
	assumes "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>"
	obtains \<open>a = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close>
	using assms unfolding the_cat_sspan_components by auto


	subsubsection\<open>Arrows\<close>

	lemma the_cat_scospan_Arr_\<aa>I[cat_ss_cs_intros]:
	assumes "a = \<aa>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Arr_\<bb>I[cat_ss_cs_intros]:
	assumes "a = \<bb>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Arr_\<oo>I[cat_ss_cs_intros]:
	assumes "a = \<oo>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Arr_\<gg>I[cat_ss_cs_intros]:
	assumes "a = \<gg>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_Arr_\<ff>I[cat_ss_cs_intros]:
	assumes "a = \<ff>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_scospan_components by simp

	lemma the_cat_scospan_ArrE:
	assumes "f \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	obtains \<open>f = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>f = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>f = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>f = \<gg>\<^sub>S\<^sub>S\<close> \| \<open>f = \<ff>\<^sub>S\<^sub>S\<close>
	using assms unfolding the_cat_scospan_components by auto

	lemma the_cat_sspan_Arr_\<aa>I[cat_ss_cs_intros]:
	assumes "a = \<aa>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Arr_\<bb>I[cat_ss_cs_intros]:
	assumes "a = \<bb>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Arr_\<oo>I[cat_ss_cs_intros]:
	assumes "a = \<oo>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Arr_\<gg>I[cat_ss_cs_intros]:
	assumes "a = \<gg>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_Arr_\<ff>I[cat_ss_cs_intros]:
	assumes "a = \<ff>\<^sub>S\<^sub>S"
	shows "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	using assms unfolding the_cat_sspan_components by simp

	lemma the_cat_sspan_ArrE:
	assumes "f \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	obtains \<open>f = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>f = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>f = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>f = \<gg>\<^sub>S\<^sub>S\<close> \| \<open>f = \<ff>\<^sub>S\<^sub>S\<close>
	using assms unfolding the_cat_sspan_components by auto


	subsubsection\<open>Domain\<close>

	mk_VLambda the_cat_scospan_components(3)
	\|vsv the_cat_scospan_Dom_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_scospan_Dom_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_scospan_Dom_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms by simp

	lemma the_cat_scospan_Dom_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms by simp

	lemma the_cat_scospan_Dom_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	lemma the_cat_scospan_Dom_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	lemma the_cat_scospan_Dom_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	mk_VLambda the_cat_sspan_components(3)
	\|vsv the_cat_sspan_Dom_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_sspan_Dom_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_sspan_Dom_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms by simp

	lemma the_cat_sspan_Dom_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms by simp

	lemma the_cat_sspan_Dom_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

	lemma the_cat_sspan_Dom_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

	lemma the_cat_sspan_Dom_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto


	subsubsection\<open>Codomain\<close>

	mk_VLambda the_cat_scospan_components(4)
	\|vsv the_cat_scospan_Cod_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_scospan_Cod_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_scospan_Cod_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms by simp

	lemma the_cat_scospan_Cod_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms by simp

	lemma the_cat_scospan_Cod_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	lemma the_cat_scospan_Cod_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	lemma the_cat_scospan_Cod_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_scospan_components assms using cat_ss_ineq by auto

	mk_VLambda the_cat_sspan_components(4)
	\|vsv the_cat_sspan_Cod_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_sspan_Cod_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_sspan_Cod_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms by simp

	lemma the_cat_sspan_Cod_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms by simp

	lemma the_cat_sspan_Cod_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<oo>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

	lemma the_cat_sspan_Cod_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<aa>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto

	lemma the_cat_sspan_Cod_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>f\<rparr> = \<bb>\<^sub>S\<^sub>S"
	unfolding the_cat_sspan_components assms using cat_ss_ineq by auto


	subsubsection\<open>Composition\<close>

	mk_VLambda the_cat_scospan_components(5)
	\|vsv the_cat_scospan_Comp_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_scospan_Comp_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_scospan_Comp_app_\<aa>\<aa>[cat_ss_cs_simps]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<bb>\<bb>[cat_ss_cs_simps]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<oo>\<oo>[cat_ss_cs_simps]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<oo>\<gg>[cat_ss_cs_simps]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<oo>\<ff>[cat_ss_cs_simps]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<gg>\<aa>[cat_ss_cs_simps]:
	assumes "g = \<gg>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g"
	unfolding the_cat_scospan_components(5) assms
	using cat_ss_ineq
	by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_scospan_Comp_app_\<ff>\<bb>[cat_ss_cs_simps]:
	assumes "g = \<ff>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = g"
	unfolding the_cat_scospan_components(5) assms
	using cat_ss_ineq
	by (auto simp: nat_omega_simps)
	qed

	mk_VLambda the_cat_sspan_components(5)
	\|vsv the_cat_sspan_Comp_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_sspan_Comp_vdomain[cat_ss_cs_simps]\|

	lemma the_cat_sspan_Comp_app_\<aa>\<aa>[cat_ss_cs_simps]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<bb>\<bb>[cat_ss_cs_simps]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<oo>\<oo>[cat_ss_cs_simps]:
	assumes "g = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	with assms show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g" "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<aa>\<gg>[cat_ss_cs_simps]:
	assumes "g = \<aa>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<bb>\<ff>[cat_ss_cs_simps]:
	assumes "g = \<bb>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f"
	unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<gg>\<oo>[cat_ss_cs_simps]:
	assumes "g = \<gg>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g"
	unfolding the_cat_sspan_components(5) assms
	using cat_ss_ineq
	by (auto simp: nat_omega_simps)
	qed

	lemma the_cat_sspan_Comp_app_\<ff>\<oo>[cat_ss_cs_simps]:
	assumes "g = \<ff>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g"
	proof-
	from assms have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_sspan_composable" by auto
	then show "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = g"
	unfolding the_cat_sspan_components(5) assms
	using cat_ss_ineq
	by (auto simp: nat_omega_simps)
	qed


	subsubsection\<open>Identity\<close>

	mk_VLambda the_cat_scospan_components(6)[folded VLambda_vid_on]
	\|vsv the_cat_scospan_CId_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_scospan_CId_vdomain[cat_ss_cs_simps]\|
	\|app the_cat_scospan_CId_app[cat_ss_cs_simps]\|

	mk_VLambda the_cat_sspan_components(6)[folded VLambda_vid_on]
	\|vsv the_cat_sspan_CId_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cat_sspan_CId_vdomain[cat_ss_cs_simps]\|
	\|app the_cat_sspan_CId_app[cat_ss_cs_simps]\|


	subsubsection\<open>Arrow with a domain and a codomain\<close>

	lemma the_cat_scospan_is_arr_\<aa>\<aa>\<aa>[cat_ss_cs_intros]:
	assumes "a' = \<aa>\<^sub>S\<^sub>S" and "b' = \<aa>\<^sub>S\<^sub>S" and "f = \<aa>\<^sub>S\<^sub>S"
	shows "f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<aa>\<^sub>S\<^sub>S" "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<aa>\<^sub>S\<^sub>S"
	by (cs_concl cs_simp: cat_ss_cs_simps)+
	qed (auto simp: the_cat_scospan_components)

	lemma the_cat_scospan_is_arr_\<bb>\<bb>\<bb>[cat_ss_cs_intros]:
	assumes "a' = \<bb>\<^sub>S\<^sub>S" and "b' = \<bb>\<^sub>S\<^sub>S" and "f = \<bb>\<^sub>S\<^sub>S"
	shows "f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = \<bb>\<^sub>S\<^sub>S" "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = \<bb>\<^sub>S\<^sub>S"
	by (cs_concl cs_simp: cat_ss_cs_simps)+
	qed (auto simp: the_cat_scospan_components)

	lemma the_cat_scospan_is_arr_\<oo>\<oo>\<oo>[cat_ss_cs_intros]:
	assumes "a' = \<oo>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f = \<oo>\<^sub>S\<^sub>S"
	shows "f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<oo>\<^sub>S\<^sub>S" "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<oo>\<^sub>S\<^sub>S"
	by (cs_concl cs_simp: cat_ss_cs_simps)+
	qed (auto simp: the_cat_scospan_components)

	lemma the_cat_scospan_is_arr_\<aa>\<oo>\<gg>[cat_ss_cs_intros]:
	assumes "a' = \<aa>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f = \<gg>\<^sub>S\<^sub>S"
	shows "f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>\<gg>\<^sub>S\<^sub>S\<rparr> = \<aa>\<^sub>S\<^sub>S" "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>\<gg>\<^sub>S\<^sub>S\<rparr> = \<oo>\<^sub>S\<^sub>S"
	by (cs_concl cs_simp: cat_ss_cs_simps)+
	qed (auto simp: the_cat_scospan_components)

	lemma the_cat_scospan_is_arr_\<bb>\<oo>\<ff>[cat_ss_cs_intros]:
	assumes "a' = \<bb>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f = \<ff>\<^sub>S\<^sub>S"
	shows "f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	proof(intro is_arrI, unfold assms)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>\<lparr>\<ff>\<^sub>S\<^sub>S\<rparr> = \<bb>\<^sub>S\<^sub>S" "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>\<lparr>\<ff>\<^sub>S\<^sub>S\<rparr> = \<oo>\<^sub>S\<^sub>S"
	by (cs_concl cs_shallow cs_simp: cat_ss_cs_simps)+
	qed (auto simp: the_cat_scospan_components)

	lemma the_cat_scospan_is_arrE:
	assumes "f' : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	obtains "a' = \<aa>\<^sub>S\<^sub>S" and "b' = \<aa>\<^sub>S\<^sub>S" and "f' = \<aa>\<^sub>S\<^sub>S"
	\| "a' = \<bb>\<^sub>S\<^sub>S" and "b' = \<bb>\<^sub>S\<^sub>S" and "f' = \<bb>\<^sub>S\<^sub>S"
	\| "a' = \<oo>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f' = \<oo>\<^sub>S\<^sub>S"
	\| "a' = \<aa>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f' = \<gg>\<^sub>S\<^sub>S"
	\| "a' = \<bb>\<^sub>S\<^sub>S" and "b' = \<oo>\<^sub>S\<^sub>S" and "f' = \<ff>\<^sub>S\<^sub>S"
	proof-
	note f = is_arrD[OF assms]
	from f(1) consider (\<aa>\<^sub>S\<^sub>S) \<open>f' = \<aa>\<^sub>S\<^sub>S\<close>
	\| (\<bb>\<^sub>S\<^sub>S) \<open>f' = \<bb>\<^sub>S\<^sub>S\<close>
	\| (\<oo>\<^sub>S\<^sub>S) \<open>f' = \<oo>\<^sub>S\<^sub>S\<close>
	\| (\<gg>\<^sub>S\<^sub>S) \<open>f' = \<gg>\<^sub>S\<^sub>S\<close>
	\| (\<ff>\<^sub>S\<^sub>S) \<open>f' = \<ff>\<^sub>S\<^sub>S\<close>
	by (elim the_cat_scospan_ArrE)
	then show ?thesis
	proof cases
	case \<aa>\<^sub>S\<^sub>S
	moreover from f(2,3)[unfolded \<aa>\<^sub>S\<^sub>S, symmetric] have "a' = \<aa>\<^sub>S\<^sub>S" "b' = \<aa>\<^sub>S\<^sub>S"
	by (simp_all add: cat_ss_cs_simps)
	ultimately show ?thesis using that by auto
	next
	case \<bb>\<^sub>S\<^sub>S
	moreover from f(2,3)[unfolded \<bb>\<^sub>S\<^sub>S, symmetric] have "a' = \<bb>\<^sub>S\<^sub>S" "b' = \<bb>\<^sub>S\<^sub>S"
	by (simp_all add: cat_ss_cs_simps)
	ultimately show ?thesis using that by auto
	next
	case \<oo>\<^sub>S\<^sub>S
	moreover from f(2,3)[unfolded \<oo>\<^sub>S\<^sub>S, symmetric] have "a' = \<oo>\<^sub>S\<^sub>S" "b' = \<oo>\<^sub>S\<^sub>S"
	by (simp_all add: cat_ss_cs_simps)
	ultimately show ?thesis using that by auto
	next
	case \<gg>\<^sub>S\<^sub>S
	moreover have "a' = \<aa>\<^sub>S\<^sub>S" "b' = \<oo>\<^sub>S\<^sub>S"
	by (simp_all add: f(2,3)[unfolded \<gg>\<^sub>S\<^sub>S, symmetric] cat_ss_cs_simps)
	ultimately show ?thesis using that by auto
	next
	case \<ff>\<^sub>S\<^sub>S
	moreover have "a' = \<bb>\<^sub>S\<^sub>S" "b' = \<oo>\<^sub>S\<^sub>S"
	by (simp_all add: f(2,3)[unfolded \<ff>\<^sub>S\<^sub>S, symmetric] cat_ss_cs_simps)
	ultimately show ?thesis using that by auto
	qed
	qed


	subsubsection\<open>\<open>\<rightarrow>\<bullet>\<leftarrow>\<close> is a finite category\<close>

	lemma (in \<Z>) finite_category_the_cat_scospan[cat_ss_cs_intros]:
	"finite_category \<alpha> (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C)"
	proof(intro finite_categoryI'' tiny_categoryI'')
	show "vfsequence (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C)" unfolding the_cat_scospan_def by simp
	show "vcard (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C) = 6\<^sub>\<nat>"
	unfolding the_cat_scospan_def by (simp_all add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" by (auto simp: the_cat_scospan_components)
	show "\<R>\<^sub>\<circ> (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" by (auto simp: the_cat_scospan_components)
	show "(gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Comp\<rparr>)) =
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b)"
	for gf
	unfolding the_cat_scospan_Comp_vdomain
	proof
	assume prems: "gf \<in>\<^sub>\<circ> cat_scospan_composable"
	then obtain g f where gf_def: "gf = [g, f]\<^sub>\<circ>" by auto
	from prems show
	"\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b"
	unfolding gf_def
	by (slow)
	(
	cases rule: cat_scospan_composableE;
	(intro exI conjI)?;
	cs_concl_step?;
	(simp only:)?,
	all\<open>intro is_arrI, unfold the_cat_scospan_components(2)\<close>
	)
	(cs_concl cs_simp: cat_ss_cs_simps V_cs_simps cs_intro: V_cs_intros)+
	next
	assume prems:
	"\<exists>g f b' c' a'. gf = [g, f]\<^sub>\<circ> \<and> g : b' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c' \<and> f : a' \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b'"
	then obtain g f b c a
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b"
	by clarsimp
	from g f show "gf \<in>\<^sub>\<circ> cat_scospan_composable"
	unfolding gf_def
	by (elim the_cat_scospan_is_arrE) (auto simp: cat_ss_cs_intros)
	qed
	show "\<D>\<^sub>\<circ> (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	by (simp add: cat_ss_cs_simps the_cat_scospan_components)
	show "g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c"
	if "g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c" and "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b" for b c g a f
	using that
	by (elim the_cat_scospan_is_arrE; simp only:)
	(
	all\<open>
	solves\<open>simp add: cat_ss_ineq cat_ss_ineq[symmetric]\<close> \|
	cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
	\<close>
	)
	show "h \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> (g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f)"
	if "h : c \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> d" and "g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c" and "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b"
	for c d h b g a f
	using that
	by (elim the_cat_scospan_is_arrE; simp only:) (slow)
	(
	all\<open>
	solves\<open>simp only: cat_ss_ineq cat_ss_ineq[symmetric]\<close> \|
	cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
	\<close>
	)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> a" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
	using that
	by (elim the_cat_scospan_ObjE)
	(
	all\<open>
	cs_concl
	cs_simp: V_cs_simps cat_ss_cs_simps
	cs_intro: V_cs_intros cat_ss_cs_intros
	\<close>
	)
	show "\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f = f" if "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b" for a b f
	using that
	by (elim the_cat_scospan_is_arrE) (slow)
	(
	cs_concl
	cs_simp: V_cs_simps cat_ss_cs_simps
	cs_intro: V_cs_intros cat_ss_cs_intros
	)+
	show "f \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr>\<lparr>b\<rparr> = f" if "f : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c" for b c f
	using that
	by (elim the_cat_scospan_is_arrE)
	(
	cs_concl
	cs_simp: V_cs_simps cat_ss_cs_simps
	cs_intro: V_cs_intros cat_ss_cs_intros
	)+
	qed
	(
	cs_concl
	cs_simp: V_cs_simps cat_ss_cs_simps the_cat_scospan_components(1,2)
	cs_intro: cat_cs_intros cat_ss_cs_intros V_cs_intros
	)+

	lemmas [cat_ss_cs_intros] = \<Z>.finite_category_the_cat_scospan


	subsubsection\<open>Duality for \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>

	lemma the_cat_scospan_op[cat_op_simps]: "op_cat (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C) = \<leftarrow>\<bullet>\<rightarrow>\<^sub>C"
	proof-
	have dom_lhs: "\<D>\<^sub>\<circ> (op_cat (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C)) = 6\<^sub>\<nat>"
	unfolding op_cat_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<leftarrow>\<bullet>\<rightarrow>\<^sub>C) = 6\<^sub>\<nat>"
	unfolding the_cat_sspan_def by (simp add: nat_omega_simps)
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	show "a \<in>\<^sub>\<circ> 6\<^sub>\<nat> \<Longrightarrow> op_cat (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C)\<lparr>a\<rparr> = \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>a\<rparr>" for a
	proof
	(
	elim_in_numeral,
	fold dg_field_simps,
	unfold op_cat_components;
	rule sym
	)
	show "\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Comp\<rparr> = fflip (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Comp\<rparr>)"
	proof(rule vsv_eqI, unfold cat_ss_cs_simps vdomain_fflip)
	fix gf assume prems: "gf \<in>\<^sub>\<circ> cat_sspan_composable"
	then obtain g f where gf_def: "gf = [g, f]\<^sub>\<circ>" by auto
	from prems have fg: "[f, g]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	unfolding gf_def by auto
	have [cat_ss_cs_simps]: "g \<circ>\<^sub>A\<^bsub>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<^esub> f = f \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> g"
	if "[f, g]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_scospan_composable"
	using that
	by (elim cat_scospan_composableE; simp only:)
	(cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros)+
	from fg show
	"\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Comp\<rparr>\<lparr>gf\<rparr> = fflip (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Comp\<rparr>)\<lparr>gf\<rparr>"
	unfolding gf_def
	by (cs_concl cs_shallow cs_simp: cat_ss_cs_simps fflip_app)
	qed (auto intro: fflip_vsv cat_ss_cs_intros)
	qed (unfold the_cat_sspan_components the_cat_scospan_components, simp_all)
	qed (auto intro: cat_op_intros cat_ss_cs_intros)
	qed

	lemma (in \<Z>) the_cat_sspan_op[cat_op_simps]: "op_cat (\<leftarrow>\<bullet>\<rightarrow>\<^sub>C) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C"
	proof-
	interpret scospan: finite_category \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close>
	by (rule finite_category_the_cat_scospan)
	interpret sspan: finite_category \<alpha> \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close>
	by (rule scospan.finite_category_op[unfolded cat_op_simps])
	from the_cat_scospan_op have "op_cat (\<leftarrow>\<bullet>\<rightarrow>\<^sub>C) = op_cat (op_cat (\<rightarrow>\<bullet>\<leftarrow>\<^sub>C))"
	by simp
	also have "\<dots> = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C" by (cs_concl cs_shallow cs_simp: cat_op_simps)
	finally show ?thesis by auto
	qed

	lemmas [cat_op_simps] = \<Z>.the_cat_sspan_op


	subsubsection\<open>\<open>\<leftarrow>\<bullet>\<rightarrow>\<close> is a finite category\<close>

	lemma (in \<Z>) finite_category_the_cat_sspan[cat_ss_cs_intros]:
	"finite_category \<alpha> (\<leftarrow>\<bullet>\<rightarrow>\<^sub>C)"
	proof-
	interpret scospan: finite_category \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close>
	by (rule finite_category_the_cat_scospan)
	show ?thesis by (rule scospan.finite_category_op[unfolded cat_op_simps])
	qed


	subsection\<open>Local assumptions for functors from \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>


	text\<open>
	The functors from \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close> are introduced as
	convenient abstractions for the definition of the
	pullbacks and the pushouts (e.g., see Chapter III-3 and
	Chapter III-4 in \cite{mac_lane_categories_2010}).
	\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	locale cf_scospan = category \<alpha> \<CC> for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> +
	assumes cf_scospan_\<gg>[cat_ss_cs_intros]: "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<oo>"
	and cf_scospan_\<ff>[cat_ss_cs_intros]: "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<oo>"

	lemma (in cf_scospan) cf_scospan_\<gg>'[cat_ss_cs_intros]:
	assumes "a = \<aa>" and "b = \<oo>"
	shows "\<gg> : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_scospan_\<gg>)

	lemma (in cf_scospan) cf_scospan_\<gg>''[cat_ss_cs_intros]:
	assumes "g = \<gg>" and "b = \<oo>"
	shows "g : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_scospan_\<gg>)

	lemma (in cf_scospan) cf_scospan_\<gg>'''[cat_ss_cs_intros]:
	assumes "g = \<gg>" and "a = \<aa>"
	shows "g : a \<mapsto>\<^bsub>\<CC>\<^esub> \<oo>"
	unfolding assms by (rule cf_scospan_\<gg>)

	lemma (in cf_scospan) cf_scospan_\<ff>'[cat_ss_cs_intros]:
	assumes "a = \<bb>" and "b = \<oo>"
	shows "\<ff> : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_scospan_\<ff>)

	lemma (in cf_scospan) cf_scospan_\<ff>''[cat_ss_cs_intros]:
	assumes "f = \<ff>" and "b = \<oo>"
	shows "f : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_scospan_\<ff>)

	lemma (in cf_scospan) cf_scospan_\<ff>'''[cat_ss_cs_intros]:
	assumes "g = \<ff>" and "b = \<bb>"
	shows "g : b \<mapsto>\<^bsub>\<CC>\<^esub> \<oo>"
	unfolding assms by (rule cf_scospan_\<ff>)

	locale cf_sspan = category \<alpha> \<CC> for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> and \<CC> +
	assumes cf_sspan_\<gg>[cat_ss_cs_intros]: "\<gg> : \<oo> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	and cf_sspan_\<ff>[cat_ss_cs_intros]: "\<ff> : \<oo> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"

	lemma (in cf_sspan) cf_sspan_\<gg>'[cat_ss_cs_intros]:
	assumes "a = \<oo>" and "b = \<aa>"
	shows "\<gg> : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_sspan_\<gg>)

	lemma (in cf_sspan) cf_sspan_\<gg>''[cat_ss_cs_intros]:
	assumes "g = \<gg>" and "a = \<aa>"
	shows "g : \<oo> \<mapsto>\<^bsub>\<CC>\<^esub> a"
	unfolding assms by (rule cf_sspan_\<gg>)

	lemma (in cf_sspan) cf_sspan_\<gg>'''[cat_ss_cs_intros]:
	assumes "g = \<gg>" and "a = \<oo>"
	shows "g : a \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	unfolding assms by (rule cf_sspan_\<gg>)

	lemma (in cf_sspan) cf_sspan_\<ff>'[cat_ss_cs_intros]:
	assumes "a = \<oo>" and "b = \<bb>"
	shows "\<ff> : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_sspan_\<ff>)

	lemma (in cf_sspan) cf_sspan_\<ff>''[cat_ss_cs_intros]:
	assumes "f = \<ff>" and "b = \<bb>"
	shows "f : \<oo> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding assms by (rule cf_sspan_\<ff>)

	lemma (in cf_sspan) cf_sspan_\<ff>'''[cat_ss_cs_intros]:
	assumes "f = \<ff>" and "b = \<oo>"
	shows "f : b \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	unfolding assms by (rule cf_sspan_\<ff>)


	text\<open>Rules.\<close>

	lemmas (in cf_scospan) [cat_ss_cs_intros] = cf_scospan_axioms

	mk_ide rf cf_scospan_def[unfolded cf_scospan_axioms_def]
	\|intro cf_scospanI\|
	\|dest cf_scospanD[dest]\|
	\|elim cf_scospanE[elim]\|

	lemmas [cat_ss_cs_intros] = cf_scospanD(1)

	lemmas (in cf_sspan) [cat_ss_cs_intros] = cf_sspan_axioms

	mk_ide rf cf_sspan_def[unfolded cf_sspan_axioms_def]
	\|intro cf_sspanI\|
	\|dest cf_sspanD[dest]\|
	\|elim cf_sspanE[elim]\|


	text\<open>Duality.\<close>

	lemma (in cf_scospan) cf_sspan_op[cat_op_intros]:
	"cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> (op_cat \<CC>)"
	by (intro cf_sspanI, unfold cat_op_simps)
	(cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+

	lemmas [cat_op_intros] = cf_scospan.cf_sspan_op

	lemma (in cf_sspan) cf_scospan_op[cat_op_intros]:
	"cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> (op_cat \<CC>)"
	by (intro cf_scospanI, unfold cat_op_simps)
	(cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+

	lemmas [cat_op_intros] = cf_sspan.cf_scospan_op



	subsection\<open>Functors from \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition the_cf_scospan :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>\<langle>_\<rightarrow>_\<rightarrow>_\<leftarrow>_\<leftarrow>_\<rangle>\<^sub>C\<^sub>F\<index>\<close> [51, 51, 51, 51, 51] 999)
	where "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>.
	if a = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>
	\| a = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>
	\| otherwise \<Rightarrow> \<oo>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>.
	if f = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>
	\| f = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>
	\| f = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<gg>
	\| f = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<ff>
	\| otherwise \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>
	),
	\<rightarrow>\<bullet>\<leftarrow>\<^sub>C,
	\<CC>
	]\<^sub>\<circ>"

	definition the_cf_sspan :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	(\<open>\<langle>_\<leftarrow>_\<leftarrow>_\<rightarrow>_\<rightarrow>_\<rangle>\<^sub>C\<^sub>F\<index>\<close> [51, 51, 51, 51, 51] 999)
	where "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>.
	if a = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>
	\| a = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>
	\| otherwise \<Rightarrow> \<oo>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>.
	if f = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>
	\| f = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>
	\| f = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<gg>
	\| f = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<ff>
	\| otherwise \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>
	),
	\<leftarrow>\<bullet>\<rightarrow>\<^sub>C,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma the_cf_scospan_components:
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>.
	if a = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>
	\| a = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>
	\| otherwise \<Rightarrow> \<oo>
	)"
	and "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>.
	if f = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>
	\| f = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>
	\| f = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<gg>
	\| f = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<ff>
	\| otherwise \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>
	)"
	and [cat_ss_cs_simps]: "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>HomDom\<rparr> = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C"
	and [cat_ss_cs_simps]: "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>HomCod\<rparr> = \<CC>"
	unfolding the_cf_scospan_def dghm_field_simps by (simp_all add: nat_omega_simps)

	lemma the_cf_sspan_components:
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>.
	if a = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<aa>
	\| a = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<bb>
	\| otherwise \<Rightarrow> \<oo>
	)"
	and "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>.
	if f = \<aa>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>
	\| f = \<bb>\<^sub>S\<^sub>S \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>
	\| f = \<gg>\<^sub>S\<^sub>S \<Rightarrow> \<gg>
	\| f = \<ff>\<^sub>S\<^sub>S \<Rightarrow> \<ff>
	\| otherwise \<Rightarrow> \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>
	)"
	and [cat_ss_cs_simps]: "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>HomDom\<rparr> = \<leftarrow>\<bullet>\<rightarrow>\<^sub>C"
	and [cat_ss_cs_simps]: "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>HomCod\<rparr> = \<CC>"
	unfolding the_cf_sspan_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	text\<open>Elementary properties.\<close>

	lemma the_cf_scospan_components_vsv[cat_ss_cs_intros]: "vsv (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)"
	unfolding the_cf_scospan_def by auto

	lemma the_cf_sspan_components_vsv[cat_ss_cs_intros]: "vsv (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)"
	unfolding the_cf_sspan_def by auto


	subsubsection\<open>Object map.\<close>

	mk_VLambda the_cf_scospan_components(1)
	\|vsv the_cf_scospan_ObjMap_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cf_scospan_ObjMap_vdomain[cat_ss_cs_simps]\|
	\|app the_cf_scospan_ObjMap_app\|

	lemma the_cf_scospan_ObjMap_app_\<aa>[cat_ss_cs_simps]:
	assumes "x = \<aa>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<aa>"
	by
	(
	cs_concl
	cs_simp: the_cf_scospan_ObjMap_app V_cs_simps assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ObjMap_app_\<bb>[cat_ss_cs_simps]:
	assumes "x = \<bb>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<bb>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ObjMap_app_\<oo>[cat_ss_cs_simps]:
	assumes "x = \<oo>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<oo>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ObjMap_vrange:
	"\<R>\<^sub>\<circ> (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold the_cf_scospan_ObjMap_vdomain,
	intro the_cf_scospan_ObjMap_vsv
	)
	fix a assume "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	then consider \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>a = \<oo>\<^sub>S\<^sub>S\<close>
	unfolding the_cat_scospan_components by auto
	then show "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
	)+
	qed

	mk_VLambda the_cf_sspan_components(1)
	\|vsv the_cf_sspan_ObjMap_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cf_sspan_ObjMap_vdomain[cat_ss_cs_simps]\|
	\|app the_cf_sspan_ObjMap_app\|

	lemma the_cf_sspan_ObjMap_app_\<aa>[cat_ss_cs_simps]:
	assumes "x = \<aa>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<aa>"
	by
	(
	cs_concl
	cs_simp: the_cf_sspan_ObjMap_app V_cs_simps assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ObjMap_app_\<bb>[cat_ss_cs_simps]:
	assumes "x = \<bb>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<bb>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ObjMap_app_\<oo>[cat_ss_cs_simps]:
	assumes "x = \<oo>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = \<oo>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ObjMap_vrange:
	"\<R>\<^sub>\<circ> (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold the_cf_sspan_ObjMap_vdomain,
	intro the_cf_sspan_ObjMap_vsv
	)
	fix a assume "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr>"
	then consider \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>a = \<oo>\<^sub>S\<^sub>S\<close>
	unfolding the_cat_sspan_components by auto
	then show "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
	)+
	qed


	subsubsection\<open>Arrow map.\<close>

	mk_VLambda the_cf_scospan_components(2)
	\|vsv the_cf_scospan_ArrMap_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cf_scospan_ArrMap_vdomain[cat_ss_cs_simps]\|
	\|app the_cf_scospan_ArrMap_app\|

	lemma (in cf_scospan) the_cf_scospan_ArrMap_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ArrMap_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ArrMap_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ArrMap_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<gg>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ArrMap_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<ff>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_scospan) the_cf_scospan_ArrMap_vrange:
	"\<R>\<^sub>\<circ> (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold the_cf_scospan_ArrMap_vdomain,
	intro the_cf_scospan_ArrMap_vsv
	)
	fix a assume "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Arr\<rparr>"
	then consider \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>a = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>a = \<gg>\<^sub>S\<^sub>S\<close> \| \<open>a = \<ff>\<^sub>S\<^sub>S\<close>
	unfolding the_cat_scospan_components by auto
	then show "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
	)+
	qed

	mk_VLambda the_cf_sspan_components(2)
	\|vsv the_cf_sspan_ArrMap_vsv[cat_ss_cs_intros]\|
	\|vdomain the_cf_sspan_ArrMap_vdomain[cat_ss_cs_simps]\|
	\|app the_cf_sspan_ArrMap_app\|

	lemma (in cf_sspan) the_cf_sspan_ArrMap_app_\<oo>[cat_ss_cs_simps]:
	assumes "f = \<oo>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<oo>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ArrMap_app_\<aa>[cat_ss_cs_simps]:
	assumes "f = \<aa>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ArrMap_app_\<bb>[cat_ss_cs_simps]:
	assumes "f = \<bb>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<bb>\<rparr>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ArrMap_app_\<gg>[cat_ss_cs_simps]:
	assumes "f = \<gg>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<gg>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ArrMap_app_\<ff>[cat_ss_cs_simps]:
	assumes "f = \<ff>\<^sub>S\<^sub>S"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<ff>"
	using cat_ss_ineq
	by
	(
	cs_concl
	cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
	cs_intro: cat_ss_cs_intros
	)

	lemma (in cf_sspan) the_cf_sspan_ArrMap_vrange:
	"\<R>\<^sub>\<circ> (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof
	(
	intro vsv.vsv_vrange_vsubset,
	unfold the_cf_sspan_ArrMap_vdomain,
	intro the_cf_sspan_ArrMap_vsv
	)
	fix a assume "a \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Arr\<rparr>"
	then consider \<open>a = \<aa>\<^sub>S\<^sub>S\<close> \| \<open>a = \<bb>\<^sub>S\<^sub>S\<close> \| \<open>a = \<oo>\<^sub>S\<^sub>S\<close> \| \<open>a = \<gg>\<^sub>S\<^sub>S\<close> \| \<open>a = \<ff>\<^sub>S\<^sub>S\<close>
	unfolding the_cat_sspan_components by auto
	then show "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
	)+
	qed


	subsubsection\<open>Functor from \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> is a functor\<close>

	lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor:
	"\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_functor.cf_is_tm_functor_if_HomDom_finite_category is_functorI')
	show "vfsequence (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)"
	unfolding the_cf_scospan_def by auto
	show "vcard (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>) = 4\<^sub>\<nat>"
	unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
	show "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b" for a b f
	using that
	by (cases rule: the_cat_scospan_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
	)+
	show "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> f\<rparr> =
	\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> c" and "f : a \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> b" for b c g a f
	using that
	by (elim the_cat_scospan_is_arrE) (very slow)
	(
	all\<open>simp only:\<close>,
	all\<open>
	solves\<open>simp add: cat_ss_ineq cat_ss_ineq[symmetric]\<close> \|
	cs_concl
	cs_simp: cat_cs_simps cat_ss_cs_simps
	cs_intro: cat_cs_intros cat_ss_cs_intros
	\<close>
	)
	show
	"\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ArrMap\<rparr>\<lparr>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	\<CC>\<lparr>CId\<rparr>\<lparr>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for c
	using that
	by (elim the_cat_scospan_ObjE; simp only:)
	(
	cs_concl
	cs_simp: V_cs_simps cat_ss_cs_simps
	cs_intro: V_cs_intros cat_ss_cs_intros
	)+

	qed
	(
	cs_concl
	cs_simp: cat_ss_cs_simps
	cs_intro:
	the_cf_scospan_ObjMap_vrange
	cat_ss_cs_intros cat_cs_intros cat_small_cs_intros
	)+

	lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor':
	assumes "\<AA>' = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C" and "\<CC>' = \<CC>"
	shows "\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule cf_scospan_the_cf_scospan_is_tm_functor)

	lemmas [cat_ss_cs_intros] = cf_scospan.cf_scospan_the_cf_scospan_is_tm_functor


	subsubsection\<open>Duality for the functors from \<open>\<rightarrow>\<bullet>\<leftarrow>\<close> and \<open>\<leftarrow>\<bullet>\<rightarrow>\<close>\<close>

	lemma op_cf_cf_scospan[cat_op_simps]:
	"op_cf (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>) = \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>"
	proof-
	have dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)) = 4\<^sub>\<nat>"
	unfolding op_cf_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>) = 4\<^sub>\<nat>"
	unfolding the_cf_sspan_def by (simp add: nat_omega_simps)
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	show "op_cf (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)\<lparr>a\<rparr> = \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> 4\<^sub>\<nat>" for a
	using that
	by
	(
	elim_in_numeral,
	fold dghm_field_simps,
	unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
	)
	(
	simp_all add:
	the_cat_scospan_components(1,2)
	the_cat_sspan_components(1,2)
	cat_op_simps
	)
	qed (auto intro: cat_op_intros cat_ss_cs_intros)
	qed

	lemma (in \<Z>) op_cf_cf_scospan[cat_op_simps]:
	"op_cf (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>) = \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>"
	proof-
	have dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)) = 4\<^sub>\<nat>"
	unfolding op_cf_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>) = 4\<^sub>\<nat>"
	unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	show "op_cf (\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>)\<lparr>a\<rparr> = \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> 4\<^sub>\<nat>" for a
	using that
	by
	(
	elim_in_numeral,
	fold dghm_field_simps,
	unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
	)
	(
	simp_all add:
	the_cat_scospan_components(1,2)
	the_cat_sspan_components(1,2)
	cat_op_simps
	)
	qed (auto intro: cat_op_intros cat_ss_cs_intros)
	qed

	lemmas [cat_op_simps] = \<Z>.op_cf_cf_scospan


	subsubsection\<open>Functor from \<open>\<leftarrow>\<bullet>\<rightarrow>\<close> is a functor\<close>

	lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor:
	"\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret scospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<open>op_cat \<CC>\<close> by (rule cf_scospan_op)
	interpret scospan:
	is_tm_functor \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<open>op_cat \<CC>\<close> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<close>
	by (rule scospan.cf_scospan_the_cf_scospan_is_tm_functor)
	show ?thesis by (rule scospan.is_tm_functor_op[unfolded cat_op_simps])
	qed

	lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor':
	assumes "\<AA>' = \<leftarrow>\<bullet>\<rightarrow>\<^sub>C" and "\<CC>' = \<CC>"
	shows "\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule cf_sspan_the_cf_sspan_is_tm_functor)

	lemmas [cat_ss_cs_intros] = cf_sspan.cf_sspan_the_cf_sspan_is_tm_functor

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SemiCAT.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SemiCAT.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SemiCAT.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_SemiCAT.thy
	@@ -1,268 +1,268 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>SemiCAT\<close>\<close>
	theory CZH_ECAT_SemiCAT
	imports
	CZH_Foundations.CZH_SMC_SemiCAT
	CZH_ECAT_Small_Category
	CZH_ECAT_Simple
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology for the exposition of \<open>SemiCAT\<close> as a category
	is analogous to the one used in \cite{milehins_category_2021}
	for the exposition of \<open>SemiCAT\<close> as a semicategory.
	\<close>

	named_theorems cat_SemiCAT_simps
	named_theorems cat_SemiCAT_intros



	subsection\<open>Definition and elementary properties\<close>

	definition cat_SemiCAT :: "V \<Rightarrow> V"
	where "cat_SemiCAT \<alpha> =
	[
	set {\<CC>. semicategory \<alpha> \<CC>},
	all_smcfs \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_smcfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_smcfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>),
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_SemiCAT \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>),
	(\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. semicategory \<alpha> \<CC>}. smcf_id \<CC>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_SemiCAT_components:
	shows "cat_SemiCAT \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. semicategory \<alpha> \<CC>}"
	and "cat_SemiCAT \<alpha>\<lparr>Arr\<rparr> = all_smcfs \<alpha>"
	and "cat_SemiCAT \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_smcfs \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "cat_SemiCAT \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_smcfs \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	and "cat_SemiCAT \<alpha>\<lparr>Comp\<rparr> =
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_SemiCAT \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_SemiCAT \<alpha>\<lparr>CId\<rparr> = (\<lambda>\<CC>\<in>\<^sub>\<circ>set {\<CC>. semicategory \<alpha> \<CC>}. smcf_id \<CC>)"
	unfolding cat_SemiCAT_def dg_field_simps
	by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_SemiCAT: "cat_smc (cat_SemiCAT \<alpha>) = smc_SemiCAT \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_SemiCAT \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_SemiCAT \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_SemiCAT_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_SemiCAT \<alpha>)) = \<D>\<^sub>\<circ> (smc_SemiCAT \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_SemiCAT \<alpha>)) \<Longrightarrow>
	cat_smc (cat_SemiCAT \<alpha>)\<lparr>a\<rparr> = smc_SemiCAT \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_SemiCAT_def smc_SemiCAT_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: cat_smc_def smc_SemiCAT_def)

	lemmas_with [folded cat_smc_SemiCAT, unfolded slicing_simps]:
	\<comment>\<open>Digraph\<close>
	cat_SemiCAT_ObjI = smc_SemiCAT_ObjI
	and cat_SemiCAT_ObjD = smc_SemiCAT_ObjD
	and cat_SemiCAT_ObjE = smc_SemiCAT_ObjE
	and cat_SemiCAT_Obj_iff[cat_SemiCAT_simps] = smc_SemiCAT_Obj_iff
	and cat_SemiCAT_Dom_app[cat_SemiCAT_simps] = smc_SemiCAT_Dom_app
	and cat_SemiCAT_Cod_app[cat_SemiCAT_simps] = smc_SemiCAT_Cod_app
	and cat_SemiCAT_is_arrI = smc_SemiCAT_is_arrI
	and cat_SemiCAT_is_arrD = smc_SemiCAT_is_arrD
	and cat_SemiCAT_is_arrE = smc_SemiCAT_is_arrE
	and cat_SemiCAT_is_arr_iff[cat_SemiCAT_simps] = smc_SemiCAT_is_arr_iff

	lemmas_with [
	folded cat_smc_SemiCAT, unfolded slicing_simps, unfolded cat_smc_SemiCAT
	]:
	\<comment>\<open>Semicategory\<close>
	cat_SemiCAT_Comp_vdomain = smc_SemiCAT_Comp_vdomain
	and cat_SemiCAT_composable_arrs_dg_SemiCAT =
	smc_SemiCAT_composable_arrs_dg_SemiCAT
	and cat_SemiCAT_Comp = smc_SemiCAT_Comp
	and cat_SemiCAT_Comp_app[cat_SemiCAT_simps] = smc_SemiCAT_Comp_app
	and cat_SemiCAT_Comp_vrange = smc_SemiCAT_Comp_vrange

	lemmas_with (in \<Z>) [folded cat_smc_SemiCAT, unfolded slicing_simps]:
	\<comment>\<open>Semicategory\<close>
	cat_SemiCAT_obj_initialI = smc_SemiCAT_obj_initialI
	and cat_SemiCAT_obj_initialD = smc_SemiCAT_obj_initialD
	and cat_SemiCAT_obj_initialE = smc_SemiCAT_obj_initialE
	and cat_SemiCAT_obj_initial_iff[cat_SemiCAT_simps] =
	smc_SemiCAT_obj_initial_iff
	and cat_SemiCAT_obj_terminalI = smc_SemiCAT_obj_terminalI
	and cat_SemiCAT_obj_terminalE = smc_SemiCAT_obj_terminalE



	subsection\<open>Identity\<close>

	lemma cat_SemiCAT_CId_app[cat_SemiCAT_simps]:
	assumes "semicategory \<alpha> \<CC>"
	shows "cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<CC>\<rparr> = smcf_id \<CC>"
	using assms unfolding cat_SemiCAT_components by simp

	lemma cat_SemiCAT_CId_vdomain[cat_SemiCAT_simps]:
	"\<D>\<^sub>\<circ> (cat_SemiCAT \<alpha>\<lparr>CId\<rparr>) = set {\<CC>. semicategory \<alpha> \<CC>}"
	unfolding cat_SemiCAT_components by auto

	lemma cat_SemiCAT_CId_vrange: "\<R>\<^sub>\<circ> (cat_SemiCAT \<alpha>\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> all_smcfs \<alpha>"
	proof(rule vsubsetI)
	fix \<HH> assume "\<HH> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (cat_SemiCAT \<alpha>\<lparr>CId\<rparr>)"
	then obtain \<AA>
	where \<HH>_def: "\<HH> = cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>"
	and \<AA>: "\<AA> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_SemiCAT \<alpha>\<lparr>CId\<rparr>)"
	unfolding cat_SemiCAT_components by auto
	from \<AA> have \<HH>_def': "\<HH> = smcf_id \<AA>"
	unfolding \<HH>_def cat_SemiCAT_CId_vdomain by (auto simp: cat_SemiCAT_CId_app)
	from \<AA> semicategory.smc_smcf_id_is_semifunctor show "\<HH> \<in>\<^sub>\<circ> all_smcfs \<alpha>"
	unfolding \<HH>_def' cat_SemiCAT_CId_vdomain by force
	qed



	subsection\<open>\<open>SemiCAT\<close> is a category\<close>

	lemma (in \<Z>) tiny_category_cat_SemiCAT:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_category \<beta> (cat_SemiCAT \<alpha>)"
	proof(intro tiny_categoryI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "vfsequence (cat_SemiCAT \<alpha>)" unfolding cat_SemiCAT_def by simp
	show "vcard (cat_SemiCAT \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_SemiCAT_def by (simp add: nat_omega_simps)
	show "cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<FF> = \<FF>"
	if "\<FF> : \<AA> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>" for \<FF> \<AA> \<BB>
	using that
	unfolding cat_SemiCAT_is_arr_iff
	by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
	show "\<FF> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr> = \<FF>"
	if "\<FF> : \<BB> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<CC>" for \<FF> \<BB> \<CC>
	using that
	unfolding cat_SemiCAT_is_arr_iff
	by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
	qed
	(
	simp_all add:
	assms
	cat_smc_SemiCAT
	cat_SemiCAT_components
	cat_SemiCAT_is_arr_iff
	tiny_semicategory_smc_SemiCAT
	semicategory.smc_smcf_id_is_semifunctor
	)



	subsection\<open>Isomorphism\<close>

	-lemma cat_SemiCAT_is_arr_isomorphismI:
	+lemma cat_SemiCAT_is_iso_arrI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	interpret is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms)
	from assms show \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	unfolding cat_SemiCAT_is_arr_iff by auto
	- note iso_thms = is_iso_semifunctor_is_arr_isomorphism[OF assms]
	+ note iso_thms = is_iso_semifunctor_is_iso_arr[OF assms]
	from iso_thms(1) show inv_\<FF>: "inv_smcf \<FF> : \<BB> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<AA>"
	unfolding cat_SemiCAT_is_arr_iff by auto
	from assms show "\<FF> : \<AA> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	unfolding cat_SemiCAT_is_arr_iff by auto
	from assms have \<AA>: "semicategory \<alpha> \<AA>" and \<BB>: "semicategory \<alpha> \<BB>" by auto
	show "inv_smcf \<FF> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<FF> = cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>\<rparr>"
	unfolding cat_SemiCAT_CId_app[OF \<AA>] cat_SemiCAT_Comp_app[OF inv_\<FF> \<FF>]
	by (rule iso_thms(2))
	show "\<FF> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> inv_smcf \<FF> = cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>\<rparr>"
	unfolding cat_SemiCAT_CId_app[OF \<BB>] cat_SemiCAT_Comp_app[OF \<FF> inv_\<FF>]
	by (rule iso_thms(3))
	qed

	-lemma cat_SemiCAT_is_arr_isomorphismD:
	+lemma cat_SemiCAT_is_iso_arrD:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	- from is_arr_isomorphismD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	+ from is_iso_arrD[OF assms] have \<FF>: "\<FF> : \<AA> \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	and "(\<exists>\<GG>. is_inverse (cat_SemiCAT \<alpha>) \<GG> \<FF>)"
	by simp_all
	then obtain \<GG> where \<GG>\<FF>: "is_inverse (cat_SemiCAT \<alpha>) \<GG> \<FF>" by clarsimp
	then obtain \<AA>' \<BB>' where \<GG>': "\<GG> : \<BB>' \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<AA>'"
	and \<FF>': "\<FF> : \<AA>' \<mapsto>\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>'"
	and \<GG>\<FF>: "\<GG> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<FF> = cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<AA>'\<rparr>"
	and \<FF>\<GG>: "\<FF> \<circ>\<^sub>A\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<GG> = cat_SemiCAT \<alpha>\<lparr>CId\<rparr>\<lparr>\<BB>'\<rparr>"
	by auto
	from \<FF> \<FF>' have \<AA>': "\<AA>' = \<AA>" and \<BB>': "\<BB>' = \<BB>" by auto
	from \<FF> have \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" unfolding cat_SemiCAT_is_arr_iff by simp
	interpret is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule \<FF>)
	have \<AA>: "semicategory \<alpha> \<AA>" and \<BB>: "semicategory \<alpha> \<BB>"
	by (cs_concl cs_intro: smc_cs_intros)+
	from \<GG>' have \<GG>: "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	unfolding \<AA>' \<BB>' cat_SemiCAT_is_arr_iff by simp
	moreover from \<GG>\<FF> have "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
	unfolding \<AA>' cat_SemiCAT_Comp_app[OF \<GG>' \<FF>'] cat_SemiCAT_CId_app[OF \<AA>]
	by simp
	moreover from \<FF>\<GG> have "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> = smcf_id \<BB>"
	unfolding \<BB>' cat_SemiCAT_Comp_app[OF \<FF>' \<GG>'] cat_SemiCAT_CId_app[OF \<BB>]
	by simp
	ultimately show ?thesis
	- using \<FF> by (elim is_arr_isomorphism_is_iso_semifunctor)
	+ using \<FF> by (elim is_iso_arr_is_iso_semifunctor)
	qed

	-lemma cat_SemiCAT_is_arr_isomorphismE:
	+lemma cat_SemiCAT_is_iso_arrE:
	assumes "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using assms by (auto dest: cat_SemiCAT_is_arr_isomorphismD)
	+ using assms by (auto dest: cat_SemiCAT_is_iso_arrD)

	-lemma cat_SemiCAT_is_arr_isomorphism_iff[cat_SemiCAT_simps]:
	+lemma cat_SemiCAT_is_iso_arr_iff[cat_SemiCAT_simps]:
	"\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	- using cat_SemiCAT_is_arr_isomorphismI cat_SemiCAT_is_arr_isomorphismD by auto
	+ using cat_SemiCAT_is_iso_arrI cat_SemiCAT_is_iso_arrD by auto



	subsection\<open>Isomorphic objects\<close>

	lemma cat_SemiCAT_obj_isoI:
	assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	proof-
	from iso_semicategoryD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_SemiCAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
	+ from cat_SemiCAT_is_iso_arrI[OF this] show ?thesis by (rule obj_isoI)
	qed

	lemma cat_SemiCAT_obj_isoD:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	from obj_isoD[OF assms] obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	by clarsimp
	- from cat_SemiCAT_is_arr_isomorphismD[OF this] show ?thesis
	+ from cat_SemiCAT_is_iso_arrD[OF this] show ?thesis
	by (rule iso_semicategoryI)
	qed

	lemma cat_SemiCAT_obj_isoE:
	assumes "\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB>"
	obtains "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (auto simp: cat_SemiCAT_obj_isoD)

	lemma cat_SemiCAT_obj_iso_iff[cat_SemiCAT_simps]:
	"\<AA> \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>cat_SemiCAT \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using cat_SemiCAT_obj_isoI cat_SemiCAT_obj_isoD by (intro iffI) auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Set.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Set.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Set.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Set.thy
	@@ -1,2232 +1,3394 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Set\<close>\<close>
	theory CZH_ECAT_Set
	imports
	CZH_Foundations.CZH_SMC_Set
	CZH_ECAT_Par
	CZH_ECAT_Subcategory
	CZH_ECAT_PCategory
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition of \<open>Set\<close> as a category is
	analogous to the one used in \cite{milehins_category_2021}
	for the exposition of \<open>Set\<close> as a semicategory.
	\<close>

	named_theorems cat_Set_cs_simps
	named_theorems cat_Set_cs_intros

	lemmas (in arr_Set) [cat_Set_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Set) [cat_cs_intros, cat_Set_cs_intros] =
	+ arr_Set_axioms'
	+
	lemmas [cat_Set_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Set.arr_Set_ArrVal_vdomain
	arr_Set_comp_Set_id_Set_left
	arr_Set_comp_Set_id_Set_right

	lemmas [cat_Set_cs_intros] =
	dg_Rel_shared_cs_intros
	arr_Set_comp_Set

	(*
	Certain lemmas are applicable to any of the categories among
	Rel, Par, Set. If these lemmas are included in general-purpose
	collections like cat_cs_simps/cat_cs_intros, then backtracking
	can become slow. The following collections were created to resolve
	such issues.
	*)
	named_theorems cat_rel_par_Set_cs_intros
	named_theorems cat_rel_par_Set_cs_simps
	named_theorems cat_rel_Par_set_cs_intros
	named_theorems cat_rel_Par_set_cs_simps
	named_theorems cat_Rel_par_set_cs_intros
	named_theorems cat_Rel_par_set_cs_simps



	subsection\<open>\<open>Set\<close> as a category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_Set :: "V \<Rightarrow> V"
	where "cat_Set \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Set \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Set \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>),
	VLambda (Vset \<alpha>) id_Set
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_Set_components:
	shows "cat_Set \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "cat_Set \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Set \<alpha> T}"
	and "cat_Set \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "cat_Set \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "cat_Set \<alpha>\<lparr>Comp\<rparr> =
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Set \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>P\<^sub>a\<^sub>r ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cat_Set \<alpha>\<lparr>CId\<rparr> = VLambda (Vset \<alpha>) id_Set"
	unfolding cat_Set_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_Set: "cat_smc (cat_Set \<alpha>) = smc_Set \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (cat_smc (cat_Set \<alpha>)) = 5\<^sub>\<nat>"
	unfolding cat_smc_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smc_Set \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Set_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (cat_smc (cat_Set \<alpha>)) = \<D>\<^sub>\<circ> (smc_Set \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (cat_smc (cat_Set \<alpha>)) \<Longrightarrow> cat_smc (cat_Set \<alpha>)\<lparr>a\<rparr> = smc_Set \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold cat_smc_def dg_field_simps cat_Set_def smc_Set_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: cat_smc_def smc_Set_def)

	lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]:
	cat_Set_Obj_iff = smc_Set_Obj_iff
	and cat_Set_Arr_iff[cat_Set_cs_simps] = smc_Set_Arr_iff
	and cat_Set_Dom_vsv[intro] = smc_Set_Dom_vsv
	and cat_Set_Dom_vdomain[simp] = smc_Set_Dom_vdomain
	and cat_Set_Dom_vrange = smc_Set_Dom_vrange
	and cat_Set_Dom_app = smc_Set_Dom_app
	and cat_Set_Cod_vsv[intro] = smc_Set_Cod_vsv
	and cat_Set_Cod_vdomain[simp] = smc_Set_Cod_vdomain
	and cat_Set_Cod_vrange = smc_Set_Cod_vrange
	and cat_Set_Cod_app[cat_Set_cs_simps] = smc_Set_Cod_app
	and cat_Set_is_arrI = smc_Set_is_arrI
	and cat_Set_is_arrD = smc_Set_is_arrD
	and cat_Set_is_arrE = smc_Set_is_arrE
	and cat_Set_ArrVal_vdomain[cat_cs_simps] = smc_Set_ArrVal_vdomain
	and cat_Set_ArrVal_app_vrange[cat_Set_cs_intros] = smc_Set_ArrVal_app_vrange

	lemmas [cat_cs_simps] = cat_Set_is_arrD(2,3)

	lemmas [cat_Set_cs_intros] =
	cat_Set_is_arrI

	lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]:
	cat_Set_composable_arrs_dg_Set = smc_Set_composable_arrs_dg_Set
	and cat_Set_Comp = smc_Set_Comp
	and cat_Set_Comp_app[cat_Set_cs_simps] = smc_Set_Comp_app
	and cat_Set_Comp_vdomain[cat_Set_cs_simps] = smc_Set_Comp_vdomain
	+ and cat_Set_is_monic_arrI = smc_Set_is_monic_arrI
	+ and cat_Set_is_monic_arrD = smc_Set_is_monic_arrD
	+ and cat_Set_is_monic_arr = smc_Set_is_monic_arr
	+ and cat_Set_is_epic_arrI = smc_Set_is_epic_arrI
	+ and cat_Set_is_epic_arrD = smc_Set_is_epic_arrD
	+ and cat_Set_is_epic_arr = smc_Set_is_epic_arr

	lemmas_with (in \<Z>) [folded cat_smc_cat_Set, unfolded slicing_simps]:
	cat_Set_Hom_vifunion_in_Vset = smc_Set_Hom_vifunion_in_Vset
	and cat_Set_incl_Set_is_arr = smc_Set_incl_Set_is_arr
	- and cat_Set_incl_Set_is_arr'[cat_Set_cs_intros] = smc_Set_incl_Set_is_arr'
	and cat_Set_Comp_ArrVal = smc_Set_Comp_ArrVal
	and cat_Set_Comp_vrange = smc_Set_Comp_vrange
	- and cat_Set_is_monic_arrI = smc_Set_is_monic_arrI
	- and cat_Set_is_monic_arr = smc_Set_is_monic_arr
	- and cat_Set_is_epic_arrI = smc_Set_is_epic_arrI
	- and cat_Set_is_epic_arrD = smc_Set_is_epic_arrD
	- and cat_Set_is_epic_arr = smc_Set_is_epic_arr
	and cat_Set_obj_terminal = smc_Set_obj_terminal
	and cat_Set_obj_initial = smc_Set_obj_initial
	and cat_Set_obj_null = smc_Set_obj_null
	and cat_Set_is_zero_arr = smc_Set_is_zero_arr

	-lemmas [cat_Set_cs_intros] = \<Z>.cat_Set_incl_Set_is_arr'
	-
	lemmas [cat_cs_simps] =
	\<Z>.cat_Set_Comp_ArrVal

	+lemma (in \<Z>) cat_Set_incl_Set_is_arr'[cat_cs_intros, cat_Set_cs_intros]:
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "A \<subseteq>\<^sub>\<circ> B"
	+ and "A' = A"
	+ and "B' = B"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "incl_Set A B : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1-3) unfolding assms(4-6) by (rule cat_Set_incl_Set_is_arr)
	+
	+lemmas [cat_Set_cs_intros] = \<Z>.cat_Set_incl_Set_is_arr'
	+

	subsubsection\<open>Identity\<close>

	lemma cat_Set_CId_app[cat_Set_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> = id_Set A"
	using assms unfolding cat_Set_components by simp

	-lemma id_Par_CId_app_app[cat_cs_simps]:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "a \<in>\<^sub>\<circ> A"
	+lemma cat_Set_CId_app_app[cat_cs_simps]:
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "a \<in>\<^sub>\<circ> A"
	shows "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = a"
	- unfolding cat_Set_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp
	+ unfolding
	+ cat_Set_CId_app[OF assms(1)[unfolded cat_Set_components(1)]]
	+ id_Rel_ArrVal_app[OF assms(2)]
	+ by simp


	subsubsection\<open>\<open>Set\<close> is a category\<close>

	lemma (in \<Z>) category_cat_Set: "category \<alpha> (cat_Set \<alpha>)"
	proof(rule categoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)

	interpret Set: semicategory \<alpha> \<open>cat_smc (cat_Set \<alpha>)\<close>
	unfolding cat_smc_cat_Set by (simp add: semicategory_smc_Set)

	show "vfsequence (cat_Set \<alpha>)" unfolding cat_Set_def by simp
	show "vcard (cat_Set \<alpha>) = 6\<^sub>\<nat>"
	unfolding cat_Set_def by (simp add: nat_omega_simps)
	show "semicategory \<alpha> (smc_Set \<alpha>)" by (simp add: semicategory_smc_Set)
	show "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	if "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" for A
	using that
	unfolding cat_Set_Obj_iff
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_cs_simps cs_intro: cat_Set_cs_intros arr_Set_id_SetI
	)

	show "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F = F"
	if "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" for F A B
	proof-
	from that have "arr_Set \<alpha> F" "B \<in>\<^sub>\<circ> Vset \<alpha>" by (auto elim: cat_Set_is_arrE)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Set_cs_simps
	cs_intro: cat_Set_cs_intros arr_Set_id_SetI
	)
	qed

	show "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr> = F"
	if "F : B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C" for F B C
	proof-
	from that have "arr_Set \<alpha> F" "B \<in>\<^sub>\<circ> Vset \<alpha>" by (auto elim: cat_Set_is_arrE)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Set_cs_simps
	cs_intro: cat_Set_cs_intros arr_Set_id_SetI
	)
	qed

	qed (auto simp: cat_Set_components)

	lemma (in \<Z>) category_cat_Set':
	assumes "\<beta> = \<alpha>"
	shows "category \<beta> (cat_Set \<alpha>)"
	unfolding assms by (rule category_cat_Set)

	lemmas [cat_cs_intros] = \<Z>.category_cat_Set'


	subsubsection\<open>\<open>Set\<close> is a wide replete subcategory of \<open>Par\<close>\<close>

	lemma (in \<Z>) wide_replete_subcategory_cat_Set_cat_Par:
	"cat_Set \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> cat_Par \<alpha>"
	proof(intro wide_replete_subcategoryI)
	show wide_subcategory_cat_Set_cat_Par: "cat_Set \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> cat_Par \<alpha>"
	proof(intro wide_subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
	interpret Par: category \<alpha> \<open>cat_Par \<alpha>\<close> by (rule category_cat_Par)
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	interpret wide_subsemicategory \<alpha> \<open>smc_Set \<alpha>\<close> \<open>smc_Par \<alpha>\<close>
	by (simp add: wide_subsemicategory_smc_Set_smc_Par)
	show "cat_Set \<alpha> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Par \<alpha>"
	proof(intro subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
	show "smc_Set \<alpha> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Par \<alpha>" by (simp add: subsemicategory_axioms)
	fix A assume "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	then show "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> = cat_Par \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	unfolding cat_Set_components cat_Par_components by simp
	qed
	(
	auto simp:
	subsemicategory_axioms Par.category_axioms Set.category_axioms
	)
	qed (rule wide_subsemicategory_smc_Set_smc_Par)
	show "cat_Set \<alpha> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> cat_Par \<alpha>"
	proof(intro replete_subcategoryI)
	interpret wide_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_subcategory_cat_Set_cat_Par)
	show "cat_Set \<alpha> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Par \<alpha>" by (rule subcategory_axioms)
	fix A B F assume "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	- note arr_Par = cat_Par_is_arr_isomorphismD[OF this]
	+ note arr_Par = cat_Par_is_iso_arrD[OF this]
	from arr_Par show "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	by (intro cat_Set_is_arrI arr_Set_arr_ParI cat_Par_is_arrD[OF arr_Par(1)])
	(auto simp: cat_Par_is_arrD(2))
	qed
	qed


	subsubsection\<open>\<open>Set\<close> is a subcategory of \<open>Set\<close>\<close>

	lemma (in \<Z>) subcategory_cat_Set_cat_Set:(TODO: generalize)
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cat_Set \<alpha> \<subseteq>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show ?thesis
	proof(intro subcategoryI')
	show "category \<beta> (cat_Set \<alpha>)"
	by (rule category.cat_category_if_ge_Limit, insert assms(2))
	(cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)+
	show "A \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>" if "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" for A
	using that
	unfolding cat_Set_components(1)
	by (meson assms(2) Vset_in_mono \<beta>.Axiom_of_Extensionality(3))
	show is_arr_if_is_arr:
	"F : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> B" if "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" for A B F
	proof-
	note f = cat_Set_is_arrD[OF that]
	interpret f: arr_Set \<alpha> F by (rule f(1))
	show ?thesis
	proof(intro cat_Set_is_arrI arr_SetI)
	show "\<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> F\<lparr>ArrCod\<rparr>"
	by (auto simp: f.arr_Set_ArrVal_vrange)
	show "F\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (auto intro!: f.arr_Set_ArrDom_in_Vset Vset_in_mono assms(2))
	show "F\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (auto intro!: f.arr_Set_ArrCod_in_Vset Vset_in_mono assms(2))
	qed
	(
	auto simp:
	f f.arr_Set_ArrVal_vdomain f.vfsequence_axioms f.arr_Set_length
	)
	qed
	show "G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F = G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F"
	if "G : B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" for B C G A F
	proof-
	note g = cat_Set_is_arrD[OF that(1)] and f = cat_Set_is_arrD[OF that(2)]
	from that have \<alpha>_gf_is_arr: "G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> C"
	by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
	from that have \<beta>_gf_is_arr: "G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> C"
	by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
	note \<alpha>_gf = cat_Set_is_arrD[OF \<alpha>_gf_is_arr]
	and \<beta>_gf = cat_Set_is_arrD[OF \<beta>_gf_is_arr]
	show ?thesis
	proof(rule arr_Set_eqI)
	show "arr_Set \<beta> (G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)" by (rule \<alpha>_gf(1))
	then interpret arr_Set_\<alpha>_gf: arr_Set \<beta> \<open>(G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<close> by simp
	from \<alpha>_gf_is_arr have dom_lhs: "\<D>\<^sub>\<circ> ((G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>) = A"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "arr_Set \<beta> (G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F)" by (rule \<beta>_gf(1))
	then interpret arr_Set_\<beta>_gf: arr_Set \<beta> \<open>(G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F)\<close> by simp
	from \<beta>_gf_is_arr have dom_rhs: "\<D>\<^sub>\<circ> ((G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F)\<lparr>ArrVal\<rparr>) = A"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "(G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr> = (G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> A"
	from that this show
	"(G \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = (G \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> F)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_arr_if_is_arr
	)
	qed auto
	qed
	(
	use \<alpha>_gf_is_arr \<beta>_gf_is_arr in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>
	)+
	qed
	qed
	(
	auto simp:
	assms(2) cat_Set_components Vset_trans Vset_in_mono cat_cs_intros
	)
	qed


	+subsubsection\<open>Further properties\<close>
	+
	+lemma cat_Set_Comp_ArrVal_vrange: (FIXME: generalize/migrate)
	+ assumes "S : B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C" and "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "\<R>\<^sub>\<circ> ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	+proof(intro vsubsetI)
	+ note SD = cat_Set_is_arrD[OF assms(1)]
	+ interpret S: arr_Set \<alpha> S
	+ rewrites "S\<lparr>ArrDom\<rparr> = B" and "S\<lparr>ArrCod\<rparr> = C"
	+ by (intro SD)+
	+ from assms(1,2) have "S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ note ST = cat_Set_is_arrD[OF this]
	+ interpret ST: arr_Set \<alpha> \<open>S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T\<close>
	+ rewrites "(S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrDom\<rparr> = A"
	+ and "(S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrCod\<rparr> = C"
	+ by (intro ST)+
	+ fix y assume prems: "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>)"
	+ with ST.arr_Set_ArrVal_vdomain obtain x
	+ where x: "x \<in>\<^sub>\<circ> A" and y_def: "y = (S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ by force
	+ show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	+ proof(intro S.ArrVal.vsv_vimageI2', unfold cat_Set_cs_simps)
	+ from assms(1,2) x show "y = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	+ unfolding y_def
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from assms(2) x show "T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> B"
	+ by (cs_concl cs_intro: cat_Set_cs_intros)
	+ qed
	+qed
	+
	+

	subsection\<open>Isomorphism\<close>

	-lemma cat_Set_is_arr_isomorphismI[intro]:
	+lemma cat_Set_is_iso_arrI[intro]:
	\<comment>\<open>
	See \cite{noauthor_nlab_nodate}\footnote{\url{
	https://ncatlab.org/nlab/show/isomorphism
	}}).
	\<close>
	assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	shows "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	proof-
	- interpret arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF assms(1)])
	- note [cat_cs_intros] = cat_Par_is_arr_isomorphismI
	- from wide_replete_subcategory_cat_Set_cat_Par assms have
	+ interpret T: arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF assms(1)])
	+ note [cat_cs_intros] = cat_Par_is_iso_arrI
	+ from T.wide_replete_subcategory_cat_Set_cat_Par assms have
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
	- with wide_replete_subcategory_cat_Set_cat_Par assms show
	+ with T.wide_replete_subcategory_cat_Set_cat_Par assms show
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_simp: cat_sub_bw_cs_simps)
	qed

	-lemma cat_Set_is_arr_isomorphismD[dest]:
	+lemma cat_Set_is_iso_arrD[dest]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof-
	from assms have T: "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" by auto
	- interpret arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF T])
	- from wide_replete_subcategory_cat_Set_cat_Par assms have T:
	+ interpret T: arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF T])
	+ from T.wide_replete_subcategory_cat_Set_cat_Par assms have T:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
	show "v11 (T\<lparr>ArrVal\<rparr>)" "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A" "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	- by (intro cat_Par_is_arr_isomorphismD[OF T])+
	-qed (rule is_arr_isomorphismD(1)[OF assms])
	-
	-lemma cat_Set_is_arr_isomorphism:
	+ by (intro cat_Par_is_iso_arrD[OF T])+
	+qed (rule is_iso_arrD(1)[OF assms])
	+
	+lemma cat_Set_is_iso_arr:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B \<and>
	v11 (T\<lparr>ArrVal\<rparr>) \<and>
	\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A \<and>
	\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	by auto

	+lemma (in \<Z>) cat_Set_is_iso_arr_if_monic_and_epic:
	+ assumes "F : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> B" and "F : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	+proof-
	+ note cat_Set_is_monic_arrD[OF assms(1)] cat_Set_is_epic_arrD[OF assms(2)]
	+ note FD = this(1,2,3,5) cat_Set_is_arrD[OF this(1)]
	+ show ?thesis by (intro cat_Set_is_iso_arrI FD)
	+qed
	+


	subsection\<open>The inverse arrow\<close>

	lemma cat_Set_ArrVal_app_is_arr[cat_cs_intros]:
	assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and "category \<alpha> \<AA>" (the order of premises is important)
	and "F : Hom \<AA> a b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c d"
	shows "F\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : c \<mapsto>\<^bsub>\<BB>\<^esub> d"
	proof-
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(2))
	interpret F: arr_Set \<alpha> F by (rule cat_Set_is_arrD[OF assms(3)])
	from assms have "F\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> Hom \<BB> c d"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Set_cs_intros)
	then show ?thesis unfolding in_Hom_iff by simp
	qed

	abbreviation (input) converse_Set :: "V \<Rightarrow> V" ("(_\<inverse>\<^sub>S\<^sub>e\<^sub>t)" [1000] 999)
	where "a\<inverse>\<^sub>S\<^sub>e\<^sub>t \<equiv> a\<inverse>\<^sub>R\<^sub>e\<^sub>l"

	lemma cat_Set_the_inverse[cat_Set_cs_simps]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	shows "T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> = T\<inverse>\<^sub>S\<^sub>e\<^sub>t"
	proof-
	from assms have T: "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" by auto
	interpret arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF T])
	from wide_replete_subcategory_cat_Set_cat_Par assms have T:
	"T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
	from wide_replete_subcategory_cat_Set_cat_Par assms
	have [symmetric, cat_cs_simps]: "T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub> = T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros
	)
	- from T show "T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> = T\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	+ from T show "T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> = T\<inverse>\<^sub>S\<^sub>e\<^sub>t"
	by (cs_concl cs_shallow cs_simp: cat_Par_cs_simps cat_cs_simps cs_intro: \<Z>_\<beta>)
	qed

	lemma cat_Set_the_inverse_app[cat_cs_intros]:
	assumes "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "a \<in>\<^sub>\<circ> A"
	and [cat_cs_simps]: "T\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = b"
	shows "(T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>)\<lparr>ArrVal\<rparr>\<lparr>b\<rparr> = a"
	proof-
	from assms have T: "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" by auto
	interpret arr_Set \<alpha> T by (rule cat_Set_is_arrD(1)[OF T])
	- note T = cat_Set_is_arr_isomorphismD[OF assms(1)]
	+ note T = cat_Set_is_iso_arrD[OF assms(1)]
	interpret T: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule T(2))
	from T.v11_axioms assms(1,2) show "T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>b\<rparr> = a"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	converse_Rel_components V_cs_simps cat_Set_cs_simps cat_cs_simps
	cs_intro: cat_arrow_cs_intros cat_cs_intros
	)
	qed

	lemma cat_Set_ArrVal_app_the_inverse_is_arr[cat_cs_intros]:
	assumes "f : c \<mapsto>\<^bsub>\<BB>\<^esub> d"
	and "category \<alpha> \<BB>" (the order of premises is important)
	and "F : Hom \<AA> a b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c d"
	shows "F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	proof-
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
	- from cat_Set_is_arr_isomorphismD[OF assms(3)] interpret F: arr_Set \<alpha> F
	+ from cat_Set_is_iso_arrD[OF assms(3)] interpret F: arr_Set \<alpha> F
	by (simp add: cat_Set_is_arrD)
	from assms have "F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> Hom \<AA> a b"
	by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros)
	then show ?thesis unfolding in_Hom_iff by simp
	qed

	lemma cat_Set_app_the_inverse_app[cat_cs_simps]:
	assumes "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B" and "b \<in>\<^sub>\<circ> B"
	shows "F\<lparr>ArrVal\<rparr>\<lparr>F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>b\<rparr>\<rparr> = b"
	proof-
	- note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
	+ note F = cat_Set_is_iso_arrD[OF assms(1)]
	note F = F cat_Set_is_arrD[OF F(1)]
	interpret F: arr_Set \<alpha> F by (rule cat_Set_is_arrD[OF F(1)])
	from assms have [cat_cs_simps]:
	"F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have [cat_cs_simps]:
	"F\<lparr>ArrVal\<rparr>\<lparr>F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>b\<rparr>\<rparr> =
	(F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>)\<lparr>ArrVal\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
	)
	- from assms F.arr_Par_ArrCod_in_Vset[unfolded F] show ?thesis
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from assms F(1) F.arr_Par_ArrCod_in_Vset[unfolded F] show ?thesis
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma cat_Set_the_inverse_app_app[cat_cs_simps]:
	assumes "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B" and "a \<in>\<^sub>\<circ> A"
	shows "F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<rparr> = a"
	proof-
	- note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
	+ note F = cat_Set_is_iso_arrD[OF assms(1)]
	note F = F cat_Set_is_arrD[OF F(1)]
	interpret F: arr_Set \<alpha> F by (rule cat_Set_is_arrD[OF F(1)])
	from assms have [cat_cs_simps]:
	"F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have [cat_cs_simps]:
	"F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<rparr> =
	(F\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
	)
	- from assms F.arr_Par_ArrDom_in_Vset[unfolded F] show ?thesis
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from assms F(1) F.arr_Par_ArrDom_in_Vset[unfolded F] show ?thesis
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+qed
	+
	+
	+
	+subsection\<open>Conversion of a single-valued relation to an arrow in \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+definition cat_Set_arr_of_vsv :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "cat_Set_arr_of_vsv f B = [f, \<D>\<^sub>\<circ> f, B]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma cat_Set_arr_of_vsv_components:
	+ shows [cat_Set_cs_simps]: "cat_Set_arr_of_vsv f B\<lparr>ArrVal\<rparr> = f"
	+ and [cat_Set_cs_simps]: "cat_Set_arr_of_vsv f B\<lparr>ArrDom\<rparr> = \<D>\<^sub>\<circ> f"
	+ and [cat_cs_simps, cat_Set_cs_simps]: "cat_Set_arr_of_vsv f B\<lparr>ArrCod\<rparr> = B"
	+ unfolding cat_Set_arr_of_vsv_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>
	+Conversion of a single-valued relation to an arrow in \<open>Set\<close> is an arrow in \<open>Set\<close>
	+\<close>
	+
	+lemma (in \<Z>) cat_Set_arr_of_vsv_is_arr:
	+ assumes "vsv r"
	+ and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> B"
	+ and "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "cat_Set_arr_of_vsv r B : \<D>\<^sub>\<circ> r \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+proof-
	+ interpret r: vsv r by (rule assms)
	+ show ?thesis
	+ proof(intro cat_Set_is_arrI arr_SetI, unfold cat_Set_arr_of_vsv_components)
	+ show "vfsequence (cat_Set_arr_of_vsv r B)"
	+ unfolding cat_Set_arr_of_vsv_def by auto
	+ show "vcard (cat_Set_arr_of_vsv r B) = 3\<^sub>\<nat>"
	+ unfolding cat_Set_arr_of_vsv_def by (auto simp: nat_omega_simps)
	+ qed (use assms in \<open>auto simp: cat_Set_components\<close>)
	+qed
	+
	+
	+
	+subsection\<open>Left restriction for \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition vlrestriction_Set :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t\<close> 80)
	+ where "T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C = [T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> C, C, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma vlrestriction_Set_components:
	+ shows [cat_Set_cs_simps]: "(T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> C"
	+ and [cat_cs_simps, cat_Set_cs_simps]: "(T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrDom\<rparr> = C"
	+ and [cat_cs_simps, cat_Set_cs_simps]: "(T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrCod\<rparr> = T\<lparr>ArrCod\<rparr>"
	+ unfolding vlrestriction_Set_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+lemma vlrestriction_Set_ArrVal_vdomain[cat_cs_simps]:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "C \<subseteq>\<^sub>\<circ> A"
	+ shows "\<D>\<^sub>\<circ> ((T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr>) = C"
	+proof-
	+ note TD = cat_Set_is_arrD[OF assms(1)]
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro TD)+
	+ from assms show ?thesis
	+ unfolding vlrestriction_Set_components
	+ by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: V_cs_intros)
	+qed
	+
	+lemma vlrestriction_Set_ArrVal_app[cat_cs_simps]:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "C \<subseteq>\<^sub>\<circ> A" and "x \<in>\<^sub>\<circ> C"
	+ shows "(T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+proof-
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro cat_Set_is_arrD[OF assms(1)])+
	+ from assms have x: "x \<in>\<^sub>\<circ> A" by auto
	+ with assms show ?thesis
	+ unfolding vlrestriction_Set_components
	+ by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: V_cs_intros)
	+qed
	+
	+
	+subsubsection\<open>Left restriction for \<open>Set\<close> is an arrow in \<open>Set\<close>\<close>
	+
	+lemma vlrestriction_Set_is_arr:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "C \<subseteq>\<^sub>\<circ> A"
	+ shows "T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C : C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+proof-
	+ note TD = cat_Set_is_arrD[OF assms(1)]
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro TD)+
	+ show ?thesis
	+ proof(intro cat_Set_is_arrI arr_SetI, unfold cat_Set_cs_simps TD(2,3))
	+ show "vfsequence (T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C)"
	+ unfolding vlrestriction_Set_def by auto
	+ show "vcard (T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C) = 3\<^sub>\<nat>"
	+ unfolding vlrestriction_Set_def by (simp add: nat_omega_simps)
	+ from assms show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> C) = C"
	+ by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> C) \<subseteq>\<^sub>\<circ> B"
	+ unfolding app_vimage_def[symmetric]
	+ proof(intro vsubsetI)
	+ fix x assume prems: "x \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> C"
	+ then obtain c where "c \<in>\<^sub>\<circ> C" and x_def: "x = T\<lparr>ArrVal\<rparr>\<lparr>c\<rparr>" by auto
	+ with assms(2) have c: "c \<in>\<^sub>\<circ> A" by auto
	+ from c assms show "x \<in>\<^sub>\<circ> B"
	+ unfolding x_def by (cs_concl cs_intro: cat_Set_cs_intros)
	+ qed
	+ from assms(2) show "C \<in>\<^sub>\<circ> Vset \<alpha>"
	+ using vsubset_in_VsetI by (auto simp: T.arr_Set_ArrDom_in_Vset)
	+ qed (auto simp: T.arr_Set_ArrCod_in_Vset)
	+qed
	+
	+lemma (in \<Z>) vlrestriction_Set_is_monic_arr:
	+ assumes "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> B" and "C \<subseteq>\<^sub>\<circ> A"
	+ shows "T \<restriction>\<^sup>l\<^sub>S\<^sub>e\<^sub>t C : C \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> B"
	+proof-
	+ note cat_Set_is_monic_arrD[OF assms(1)]
	+ note TD = this cat_Set_is_arrD[OF this(1)]
	+ interpret F: arr_Set \<alpha> T by (intro TD)+
	+ interpret ArrVal: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule TD(2))
	+ show ?thesis
	+ proof
	+ (
	+ intro
	+ cat_Set_is_monic_arrI
	+ vlrestriction_Set_is_arr[OF TD(1) assms(2)],
	+ unfold cat_Set_cs_simps
	+ )
	+ from TD(1) assms(2) show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> C) = C"
	+ by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
	+ qed auto
	+qed
	+
	+
	+
	+subsection\<open>Right restriction for \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition vrrestriction_Set :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t\<close> 80)
	+ where "T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C = [T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>r\<^sub>\<circ> C, T\<lparr>ArrDom\<rparr>, C]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma vrrestriction_Set_components:
	+ shows [cat_Set_cs_simps]: "(T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr> \<restriction>\<^sup>r\<^sub>\<circ> C"
	+ and [cat_cs_simps, cat_Set_cs_simps]: "(T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrDom\<rparr> = T\<lparr>ArrDom\<rparr>"
	+ and [cat_cs_simps, cat_Set_cs_simps]: "(T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrCod\<rparr> = C"
	+ unfolding vrrestriction_Set_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+lemma vrrestriction_Set_ArrVal_app[cat_cs_simps]:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> C"
	+ shows "(T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr>"
	+proof-
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro cat_Set_is_arrD[OF assms(1)])+
	+ from assms show ?thesis unfolding cat_Set_cs_simps by simp
	+qed
	+
	+
	+subsubsection\<open>Right restriction for \<open>Set\<close> is an arrow in \<open>Set\<close>\<close>
	+
	+lemma vrrestriction_Set_is_arr:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> C"
	+ and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C"
	+proof-
	+ note TD = cat_Set_is_arrD[OF assms(1)]
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro TD)+
	+ show ?thesis
	+ proof(intro cat_Set_is_arrI arr_SetI, unfold cat_Set_cs_simps)
	+ show "vfsequence (T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)" unfolding vrrestriction_Set_def by auto
	+ show "vcard (T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C) = 3\<^sub>\<nat>"
	+ unfolding vrrestriction_Set_def by (simp add: nat_omega_simps)
	+ qed
	+ (
	+ use assms(2,3) in
	+ \<open>
	+ auto simp:
	+ TD(2)
	+ cat_Set_components
	+ T.arr_Set_ArrVal_vdomain
	+ T.arr_Set_ArrDom_in_Vset
	+ \<close>
	+ )
	+qed
	+
	+lemma vrrestriction_Set_is_arr'[cat_cs_intros]:
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> C"
	+ and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "C' = C"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C : A \<mapsto>\<^bsub>\<CC>'\<^esub> C'"
	+ using assms(1-3) unfolding assms(4,5) by (rule vrrestriction_Set_is_arr)
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma
	+ assumes "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows vrrestriction_Set_vrange_is_arr:
	+ "T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+ and vrrestriction_Set_vrange_ArrVal_app[cat_cs_simps, cat_Set_cs_simps]:
	+ "(T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>))\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr>"
	+proof(intro vrrestriction_Set_is_arr, rule assms)
	+ note TD = cat_Set_is_arrD[OF assms(1)]
	+ interpret T: arr_Set \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro TD)+
	+ show "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (auto simp: cat_Set_components T.arr_Rel_ArrVal_in_Vset vrange_in_VsetI)
	+qed (auto intro: vrrestriction_Set_ArrVal_app[OF assms])
	+
	+lemma (in \<Z>) vrrestriction_Set_vrange_is_iso_arr:
	+ assumes "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "T \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+proof-
	+ note cat_Set_is_monic_arrD[OF assms]
	+ note TD = this cat_Set_is_arrD[OF this(1)]
	+ interpret T: arr_Set \<alpha> T by (intro TD)+
	+ show ?thesis
	+ by
	+ (
	+ intro cat_Set_is_iso_arrI vrrestriction_Set_vrange_is_arr[OF TD(1)],
	+ unfold cat_Set_cs_simps
	+ )
	+ (simp_all add: TD(2,3))
	+qed
	+
	+
	+subsubsection\<open>Connections\<close>
	+
	+lemma cat_Set_Comp_vrrestriction_Set:
	+ assumes "S : B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C"
	+ and "T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "\<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> D"
	+ and "D \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T = (S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D"
	+proof-
	+
	+ note SD = cat_Set_is_arrD[OF assms(1)]
	+ interpret S: arr_Set \<alpha> S
	+ rewrites [cat_cs_simps]: "S\<lparr>ArrDom\<rparr> = B" and [cat_cs_simps]: "S\<lparr>ArrCod\<rparr> = C"
	+ by (intro SD)+
	+ note TD = cat_Set_is_arrD[OF assms(2)]
	+ interpret T: arr_Set \<alpha> T
	+ rewrites [cat_cs_simps]: "T\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro TD)+
	+
	+ from assms(3) S.arr_Par_ArrVal_vrange have RS_D: "\<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> D" by auto
	+
	+ from assms(1,2) have "S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> C"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+
	+ from assms(1,2) have "\<R>\<^sub>\<circ> ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	+ by (intro cat_Set_Comp_ArrVal_vrange)
	+ with assms(3) have RST: "\<R>\<^sub>\<circ> ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> D" by auto
	+
	+ from assms(1,2,4) RS_D have SD_T:
	+ "S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> D"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>) = A"
	+ by (simp add: cat_cs_simps)
	+
	+ from assms(1,2,4) RST have ST_D:
	+ "(S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> D"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> (((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D)\<lparr>ArrVal\<rparr>) = A"
	+ by (simp add: cat_cs_simps)
	+
	+ show "S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T = (S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ show
	+ "(S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr> =
	+ ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> A"
	+ with assms(1,2,4) RST RS_D show
	+ "(S \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	+ ((S \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> T) \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t D)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use SD_T ST_D in \<open>auto dest: cat_Set_is_arrD\<close>)
	+ qed (use SD_T ST_D in \<open>auto simp: cat_Set_is_arrD\<close>)
	+
	+qed
	+
	+lemma (in \<Z>) cat_Set_CId_vrrestriction_Set[cat_cs_simps]:
	+ assumes "A \<subseteq>\<^sub>\<circ> B" and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t B = incl_Set A B"
	+proof-
	+
	+ from assms have A: "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components by auto
	+ from A have CId_A: "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ with cat_Set_is_arrD[OF CId_A] assms(1) have RA_B:
	+ "\<R>\<^sub>\<circ> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> B"
	+ by (auto intro: arr_Set.arr_Set_ArrVal_vrange)
	+
	+ with assms A assms(1,2) have lhs_is_arr:
	+ "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t B : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t B)\<lparr>ArrVal\<rparr>) = A"
	+ by (simp add: cat_cs_simps)
	+
	+ from A assms(1,2) have rhs_is_arr: "incl_Set A B : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> ((incl_Set A B)\<lparr>ArrVal\<rparr>) = A"
	+ by (simp add: cat_cs_simps)
	+
	+ show ?thesis
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ show "(cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t B)\<lparr>ArrVal\<rparr> = incl_Rel A B\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> A"
	+ with A RA_B show
	+ "(cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t B)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = incl_Rel A B\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use lhs_is_arr rhs_is_arr in \<open>auto dest: cat_Set_is_arrD\<close>)
	+ qed (use lhs_is_arr rhs_is_arr in \<open>auto simp: cat_Set_is_arrD\<close>)
	+
	+qed
	+
	+lemma cat_Set_Comp_incl_Rel_vrrestriction_Set[cat_cs_simps]:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "C \<subseteq>\<^sub>\<circ> B" and "\<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> C"
	+ shows "incl_Rel C B \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C = F"
	+proof-
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ from assms(2) have C: "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components(1) by (auto intro: F.arr_Par_ArrCod_in_Vset)
	+ from assms C have lhs_is_arr:
	+ "incl_Rel C B \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((incl_Rel C B \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr>) = A"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ from assms(1) have dom_rhs: "\<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) = A"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show ?thesis
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ show "(incl_Rel C B \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr> = F\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> A"
	+ with assms F.ArrVal.vsv_vimageI2 have "F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> C"
	+ by (auto simp: F.arr_Set_ArrVal_vdomain)
	+ with prems assms C show
	+ "(incl_Rel C B \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F \<restriction>\<^sup>r\<^sub>S\<^sub>e\<^sub>t C)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use assms(1) lhs_is_arr in \<open>auto dest: cat_Set_is_arrD\<close>)
	+ qed (use assms(1) lhs_is_arr in \<open>auto dest: cat_Set_is_arrD\<close>)
	qed



	subsection\<open>Projection arrows for \<open>vtimes\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition vfst_arrow :: "V \<Rightarrow> V \<Rightarrow> V"
	where "vfst_arrow A B = [(\<lambda>ab\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> B. vfst ab), A \<times>\<^sub>\<circ> B, A]\<^sub>\<circ>"

	definition vsnd_arrow :: "V \<Rightarrow> V \<Rightarrow> V"
	where "vsnd_arrow A B = [(\<lambda>ab\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> B. vsnd ab), A \<times>\<^sub>\<circ> B, B]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma vfst_arrow_components:
	shows "vfst_arrow A B\<lparr>ArrVal\<rparr> = (\<lambda>ab\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> B. vfst ab)"
	and [cat_cs_simps]: "vfst_arrow A B\<lparr>ArrDom\<rparr> = A \<times>\<^sub>\<circ> B"
	and [cat_cs_simps]: "vfst_arrow A B\<lparr>ArrCod\<rparr> = A"
	unfolding vfst_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)

	lemma vsnd_arrow_components:
	shows "vsnd_arrow A B\<lparr>ArrVal\<rparr> = (\<lambda>ab\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> B. vsnd ab)"
	and [cat_cs_simps]: "vsnd_arrow A B\<lparr>ArrDom\<rparr> = A \<times>\<^sub>\<circ> B"
	and [cat_cs_simps]: "vsnd_arrow A B\<lparr>ArrCod\<rparr> = B"
	unfolding vsnd_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow value\<close>

	mk_VLambda vfst_arrow_components(1)
	\|vsv vfst_arrow_ArrVal_vsv[cat_cs_intros]\|
	\|vdomain vfst_arrow_ArrVal_vdomain[cat_cs_simps]\|
	\|app vfst_arrow_ArrVal_app'\|

	mk_VLambda vsnd_arrow_components(1)
	\|vsv vsnd_arrow_ArrVal_vsv[cat_cs_intros]\|
	\|vdomain vsnd_arrow_ArrVal_vdomain[cat_cs_simps]\|
	\|app vsnd_arrow_ArrVal_app'\|

	lemma vfst_arrow_ArrVal_app[cat_cs_simps]:
	assumes "ab = \<langle>a, b\<rangle>" and "ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	shows "vfst_arrow A B\<lparr>ArrVal\<rparr>\<lparr>ab\<rparr> = a"
	using assms(2) unfolding assms(1) by (simp add: vfst_arrow_ArrVal_app')

	lemma vfst_arrow_vrange: "\<R>\<^sub>\<circ> (vfst_arrow A B\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A"
	unfolding vfst_arrow_components
	proof(intro vrange_VLambda_vsubset)
	fix ab assume "ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	then obtain a b where ab_def: "ab = \<langle>a, b\<rangle>" and a: "a \<in>\<^sub>\<circ> A" by clarsimp
	from a show "vfst ab \<in>\<^sub>\<circ> A" unfolding ab_def by simp
	qed

	lemma vsnd_arrow_ArrVal_app[cat_cs_simps]:
	assumes "ab = \<langle>a, b\<rangle>" and "ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	shows "vsnd_arrow A B\<lparr>ArrVal\<rparr>\<lparr>ab\<rparr> = b"
	using assms(2) unfolding assms(1) by (simp add: vsnd_arrow_ArrVal_app')

	lemma vsnd_arrow_vrange: "\<R>\<^sub>\<circ> (vsnd_arrow A B\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> B"
	unfolding vsnd_arrow_components
	proof(intro vrange_VLambda_vsubset)
	fix ab assume "ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	then obtain a b where ab_def: "ab = \<langle>a, b\<rangle>" and b: "b \<in>\<^sub>\<circ> B" by clarsimp
	from b show "vsnd ab \<in>\<^sub>\<circ> B" unfolding ab_def by simp
	qed


	subsubsection\<open>Projection arrows are arrows in the category \<open>Set\<close>\<close>

	lemma (in \<Z>) vfst_arrow_is_cat_Set_arr_Vset:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vfst_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	proof(intro cat_Set_is_arrI arr_SetI, unfold cat_cs_simps)
	show "vfsequence (vfst_arrow A B)" unfolding vfst_arrow_def by simp
	show "vcard (vfst_arrow A B) = 3\<^sub>\<nat>"
	unfolding vfst_arrow_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (vfst_arrow A B\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A" by (rule vfst_arrow_vrange)
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros\<close>)+

	lemma (in \<Z>) vfst_arrow_is_cat_Set_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	using assms
	unfolding cat_Set_components
	by (rule vfst_arrow_is_cat_Set_arr_Vset)

	lemma (in \<Z>) vfst_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Set \<alpha>"
	shows "vfst_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> A'"
	using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Set_arr)

	lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vfst_arrow_is_cat_Set_arr'

	lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr_Vset:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vsnd_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	proof(intro cat_Set_is_arrI arr_SetI , unfold cat_cs_simps)
	show "vfsequence (vsnd_arrow A B)" unfolding vsnd_arrow_def by simp
	show "vcard (vsnd_arrow A B) = 3\<^sub>\<nat>"
	unfolding vsnd_arrow_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (vsnd_arrow A B\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> B" by (rule vsnd_arrow_vrange)
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros\<close>)+

	lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	using assms
	unfolding cat_Set_components
	by (rule vsnd_arrow_is_cat_Set_arr_Vset)

	lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "B' = B"
	and "\<CC>' = cat_Set \<alpha>"
	shows "vsnd_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Set_arr)

	lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Set_arr'


	subsubsection\<open>Projection arrows are arrows in the category \<open>Par\<close>\<close>

	lemma (in \<Z>) vfst_arrow_is_cat_Par_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> A"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	from assms show ?thesis
	unfolding cat_Par_components(1)
	by (intro Set_Par.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) vfst_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Par \<alpha>"
	shows "vfst_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> A'"
	using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Par_arr)

	lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Par_arr'

	lemma (in \<Z>) vsnd_arrow_is_cat_Par_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> B"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	from assms show ?thesis
	unfolding cat_Par_components(1)
	by (intro Set_Par.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) vsnd_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "B' = B"
	and "\<CC>' = cat_Par \<alpha>"
	shows "vsnd_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Par_arr)

	lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Par_arr'


	subsubsection\<open>Projection arrows are arrows in the category \<open>Rel\<close>\<close>

	lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule subcat_trans[
	OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
	]
	)
	from assms show ?thesis
	unfolding cat_Rel_components(1)
	by (intro Set_Rel.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "vfst_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> A'"
	using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Rel_arr)

	lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Rel_arr'

	lemma (in \<Z>) vsnd_arrow_is_cat_Rel_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow A B : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule subcat_trans[
	OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
	]
	)
	from assms show ?thesis
	unfolding cat_Rel_components(1)
	by (intro Set_Rel.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) vsnd_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> B"
	and "B' = B"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "vsnd_arrow A B : AB \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Rel_arr)

	lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Rel_arr'


	subsubsection\<open>Projection arrows are isomorphisms in the category \<open>Set\<close>\<close>

	-lemma (in \<Z>) vfst_arrow_is_cat_Set_arr_isomorphism_Vset:
	+lemma (in \<Z>) vfst_arrow_is_cat_Set_iso_arr_Vset:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vfst_arrow A (set {b}) : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> A"
	proof
	(
	intro
	- cat_Set_is_arr_isomorphismI
	+ cat_Set_is_iso_arrI
	arr_SetI
	vfst_arrow_is_cat_Set_arr_Vset
	assms,
	unfold cat_cs_simps
	)
	show "v11 (vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>)"
	proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
	fix ab ab' assume prems:
	"ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> set {b}"
	"ab' \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> set {b}"
	"vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>\<lparr>ab\<rparr> = vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>\<lparr>ab'\<rparr>"
	from prems obtain a where ab_def: "ab = \<langle>a, b\<rangle>" and a: "a \<in>\<^sub>\<circ> A"
	by clarsimp
	from prems obtain a' where ab'_def: "ab' = \<langle>a', b\<rangle>" and a': "a' \<in>\<^sub>\<circ> A"
	by clarsimp
	from prems(3) a a' have "a = a'"
	unfolding ab_def ab'_def
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	then show "ab = ab'" unfolding ab_def ab'_def by simp
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "\<R>\<^sub>\<circ> (vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>) = A"
	proof(intro vsubset_antisym)
	show "A \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>)"
	proof(intro vsubsetI)
	fix a assume a: "a \<in>\<^sub>\<circ> A"
	then have a_def: "a = vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>\<lparr>\<langle>a, b\<rangle>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	from a assms show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfst_arrow A (set {b})\<lparr>ArrVal\<rparr>)"
	by (subst a_def, use nothing in \<open>intro vsv.vsv_vimageI2\<close>)
	(auto simp: cat_cs_simps cat_cs_intros)
	qed
	qed (rule vfst_arrow_vrange)
	qed (use assms in auto)

	-lemma (in \<Z>) vfst_arrow_is_cat_Set_arr_isomorphism:
	+lemma (in \<Z>) vfst_arrow_is_cat_Set_iso_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A (set {b}) : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> A"
	using assms
	unfolding cat_Set_components
	- by (rule vfst_arrow_is_cat_Set_arr_isomorphism_Vset)
	-
	-lemma (in \<Z>) vfst_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
	+ by (rule vfst_arrow_is_cat_Set_iso_arr_Vset)
	+
	+lemma (in \<Z>) vfst_arrow_is_cat_Set_iso_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> set {b}"
	and "A' = A"
	and "\<CC>' = cat_Set \<alpha>"
	shows "vfst_arrow A (set {b}) : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> A"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vfst_arrow_is_cat_Set_arr_isomorphism)
	-
	-lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vfst_arrow_is_cat_Set_arr_isomorphism'
	-
	-lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr_isomorphism_Vset:
	+ by (rule vfst_arrow_is_cat_Set_iso_arr)
	+
	+lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vfst_arrow_is_cat_Set_iso_arr'
	+
	+lemma (in \<Z>) vsnd_arrow_is_cat_Set_iso_arr_Vset:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vsnd_arrow (set {a}) B : set {a} \<times>\<^sub>\<circ> B \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	proof
	(
	intro
	- cat_Set_is_arr_isomorphismI
	+ cat_Set_is_iso_arrI
	arr_SetI
	vsnd_arrow_is_cat_Set_arr_Vset
	assms,
	unfold cat_cs_simps
	)
	show "v11 (vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>)"
	proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
	fix ab ab' assume prems:
	"ab \<in>\<^sub>\<circ> set {a} \<times>\<^sub>\<circ> B"
	"ab' \<in>\<^sub>\<circ> set {a} \<times>\<^sub>\<circ> B"
	"vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>\<lparr>ab\<rparr> = vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>\<lparr>ab'\<rparr>"
	from prems obtain b where ab_def: "ab = \<langle>a, b\<rangle>" and b: "b \<in>\<^sub>\<circ> B"
	by clarsimp
	from prems obtain b' where ab'_def: "ab' = \<langle>a, b'\<rangle>" and b': "b' \<in>\<^sub>\<circ> B"
	by clarsimp
	from prems(3) b b' have "b = b'"
	unfolding ab_def ab'_def
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	then show "ab = ab'" unfolding ab_def ab'_def by simp
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "\<R>\<^sub>\<circ> (vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>) = B"
	proof(intro vsubset_antisym)
	show "B \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>)"
	proof(intro vsubsetI)
	fix b assume b: "b \<in>\<^sub>\<circ> B"
	then have b_def: "b = vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>\<lparr>\<langle>a, b\<rangle>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	from b assms show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vsnd_arrow (set {a}) B\<lparr>ArrVal\<rparr>)"
	by (subst b_def, use nothing in \<open>intro vsv.vsv_vimageI2\<close>)
	(auto simp: cat_cs_simps cat_cs_intros)
	qed
	qed (rule vsnd_arrow_vrange)
	qed (use assms in auto)

	-lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr_isomorphism:
	+lemma (in \<Z>) vsnd_arrow_is_cat_Set_iso_arr:
	assumes "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow (set {a}) B : set {a} \<times>\<^sub>\<circ> B \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	using assms
	unfolding cat_Set_components
	- by (rule vsnd_arrow_is_cat_Set_arr_isomorphism_Vset)
	-
	-lemma (in \<Z>) vsnd_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
	+ by (rule vsnd_arrow_is_cat_Set_iso_arr_Vset)
	+
	+lemma (in \<Z>) vsnd_arrow_is_cat_Set_iso_arr'[cat_rel_par_Set_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "AB = set {a} \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Set \<alpha>"
	shows "vsnd_arrow (set {a}) B : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vsnd_arrow_is_cat_Set_arr_isomorphism)
	-
	-lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Set_arr_isomorphism'
	+ by (rule vsnd_arrow_is_cat_Set_iso_arr)
	+
	+lemmas [cat_rel_par_Set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Set_iso_arr'


	subsubsection\<open>Projection arrows are isomorphisms in the category \<open>Par\<close>\<close>

	-lemma (in \<Z>) vfst_arrow_is_cat_Par_arr_isomorphism:
	+lemma (in \<Z>) vfst_arrow_is_cat_Par_iso_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A (set {b}) : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> A"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	show "vfst_arrow A (set {b}) : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> A"
	by
	(
	- rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Par.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
	+ OF vfst_arrow_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Par_components]
	]
	]
	)
	qed

	-lemma (in \<Z>) vfst_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
	+lemma (in \<Z>) vfst_arrow_is_cat_Par_iso_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> set {b}"
	and "A' = A"
	and "\<CC>' = cat_Par \<alpha>"
	shows "vfst_arrow A (set {b}) : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> A"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vfst_arrow_is_cat_Par_arr_isomorphism)
	-
	-lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Par_arr_isomorphism'
	-
	-lemma (in \<Z>) vsnd_arrow_is_cat_Par_arr_isomorphism:
	+ by (rule vfst_arrow_is_cat_Par_iso_arr)
	+
	+lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Par_iso_arr'
	+
	+lemma (in \<Z>) vsnd_arrow_is_cat_Par_iso_arr:
	assumes "a \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow (set {a}) B : set {a} \<times>\<^sub>\<circ> B \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	show "vsnd_arrow (set {a}) B : set {a} \<times>\<^sub>\<circ> B \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
	by
	(
	- rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Par.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
	+ OF vsnd_arrow_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Par_components]
	]
	]
	)
	qed

	-lemma (in \<Z>) vsnd_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
	+lemma (in \<Z>) vsnd_arrow_is_cat_Par_iso_arr'[cat_rel_Par_set_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "AB = set {a} \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Par \<alpha>"
	shows "vsnd_arrow (set {a}) B : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vsnd_arrow_is_cat_Par_arr_isomorphism)
	-
	-lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Par_arr_isomorphism'
	+ by (rule vsnd_arrow_is_cat_Par_iso_arr)
	+
	+lemmas [cat_rel_Par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Par_iso_arr'


	subsubsection\<open>Projection arrows are isomorphisms in the category \<open>Rel\<close>\<close>

	-lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr_isomorphism:
	+lemma (in \<Z>) vfst_arrow_is_cat_Rel_iso_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "vfst_arrow A (set {b}) : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> A"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule wr_subcat_trans
	[
	OF
	Set_Par.wide_replete_subcategory_axioms
	Par_Rel.wide_replete_subcategory_axioms
	]
	)
	show ?thesis
	by
	(
	- rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Rel.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
	+ OF vfst_arrow_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Rel_components]
	]
	]
	)
	qed

	-lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
	+lemma (in \<Z>) vfst_arrow_is_cat_Rel_iso_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "AB = A \<times>\<^sub>\<circ> set {b}"
	and "A' = A"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "vfst_arrow A (set {b}) : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> A"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vfst_arrow_is_cat_Rel_arr_isomorphism)
	-
	-lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Rel_arr_isomorphism'
	-
	-lemma (in \<Z>) vsnd_arrow_is_cat_Rel_arr_isomorphism:
	+ by (rule vfst_arrow_is_cat_Rel_iso_arr)
	+
	+lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vfst_arrow_is_cat_Rel_iso_arr'
	+
	+lemma (in \<Z>) vsnd_arrow_is_cat_Rel_iso_arr:
	assumes "a \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "vsnd_arrow (set {a}) B : set {a} \<times>\<^sub>\<circ> B \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> B"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule wr_subcat_trans
	[
	OF
	Set_Par.wide_replete_subcategory_axioms
	Par_Rel.wide_replete_subcategory_axioms
	]
	)
	show ?thesis
	by
	(
	- rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Rel.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
	+ OF vsnd_arrow_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Rel_components]
	]
	]
	)
	qed

	-lemma (in \<Z>) vsnd_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
	+lemma (in \<Z>) vsnd_arrow_is_cat_Rel_iso_arr'[cat_Rel_par_set_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "AB = set {a} \<times>\<^sub>\<circ> B"
	and "A' = A"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "vsnd_arrow (set {a}) B : AB \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B"
	using assms(1-2)
	unfolding assms(3-5)
	- by (rule vsnd_arrow_is_cat_Rel_arr_isomorphism)
	-
	-lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Rel_arr_isomorphism'
	+ by (rule vsnd_arrow_is_cat_Rel_iso_arr)
	+
	+lemmas [cat_Rel_par_set_cs_intros] = \<Z>.vsnd_arrow_is_cat_Rel_iso_arr'



	subsection\<open>Projection arrow for \<open>vproduct\<close>\<close>

	definition vprojection_arrow :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V"
	where "vprojection_arrow I A i = [vprojection I A i, (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i), A i]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma vprojection_arrow_components:
	shows "vprojection_arrow I A i\<lparr>ArrVal\<rparr> = vprojection I A i"
	and "vprojection_arrow I A i\<lparr>ArrDom\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	and "vprojection_arrow I A i\<lparr>ArrCod\<rparr> = A i"
	unfolding vprojection_arrow_def arr_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Projection arrow value\<close>

	mk_VLambda vprojection_arrow_components(1)[unfolded vprojection_def]
	- \|vsv vprojection_arrow_vsv[cat_Set_cs_intros]\|
	- \|vdomain vprojection_arrow_vdomain[cat_Set_cs_simps]\|
	- \|app vprojection_arrow_app[cat_Set_cs_simps]\|
	+ \|vsv vprojection_arrow_ArrVal_vsv[cat_Set_cs_intros]\|
	+ \|vdomain vprojection_arrow_ArrVal_vdomain[cat_Set_cs_simps]\|
	+ \|app vprojection_arrow_ArrVal_app[cat_Set_cs_simps]\|


	subsubsection\<open>Projection arrow is an arrow in the category \<open>Set\<close>\<close>

	lemma (in \<Z>) arr_Set_vprojection_arrow:
	assumes "i \<in>\<^sub>\<circ> I" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Set \<alpha> (vprojection_arrow I A i)"
	proof(intro arr_SetI)
	show "vfsequence (vprojection_arrow I A i)"
	unfolding vprojection_arrow_def by auto
	show "vcard (vprojection_arrow I A i) = 3\<^sub>\<nat>"
	unfolding vprojection_arrow_def by (simp add: nat_omega_simps)
	show "vprojection_arrow I A i\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vprojection_arrow_components
	proof-
	from assms(1) have "i \<in>\<^sub>\<circ> I" by simp
	then have "A i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I A)" by auto
	moreover from assms(2) have "\<R>\<^sub>\<circ> (VLambda I A) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (meson vrange_in_VsetI)
	ultimately show "A i \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed
	qed
	(
	auto
	simp: vprojection_arrow_components
	intro!:
	assms
	vprojection_vrange_vsubset
	Limit_vproduct_in_Vset_if_VLambda_in_VsetI
	)

	lemma (in \<Z>) vprojection_arrow_is_arr:
	assumes "i \<in>\<^sub>\<circ> I" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vprojection_arrow I A i : (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A i"
	proof(intro cat_Set_is_arrI)
	from assms show "arr_Set \<alpha> (vprojection_arrow I A i)"
	by (rule arr_Set_vprojection_arrow)
	qed (simp_all add: vprojection_arrow_components)



	+subsection\<open>Canonical injection arrow for \<open>vdunion\<close>\<close>
	+
	+definition vcinjection_arrow :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V"
	+ where "vcinjection_arrow I A i = [vcinjection A i, A i, (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma vcinjection_arrow_components:
	+ shows "vcinjection_arrow I A i\<lparr>ArrVal\<rparr> = vcinjection A i"
	+ and "vcinjection_arrow I A i\<lparr>ArrDom\<rparr> = A i"
	+ and "vcinjection_arrow I A i\<lparr>ArrCod\<rparr> = (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+ unfolding vcinjection_arrow_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Canonical injection arrow value\<close>
	+
	+mk_VLambda vcinjection_arrow_components(1)[unfolded vcinjection_def]
	+ \|vsv vcinjection_arrow_ArrVal_vsv[cat_Set_cs_intros]\|
	+ \|vdomain vcinjection_arrow_ArrVal_vdomain[cat_Set_cs_simps]\|
	+ \|app vcinjection_arrow_ArrVal_app[cat_Set_cs_simps]\|
	+
	+
	+subsubsection\<open>Canonical injection arrow is an arrow in the category \<open>Set\<close>\<close>
	+
	+lemma (in \<Z>) arr_Set_vcinjection_arrow:
	+ assumes "i \<in>\<^sub>\<circ> I" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "arr_Set \<alpha> (vcinjection_arrow I A i)"
	+proof(intro arr_SetI)
	+ show "vfsequence (vcinjection_arrow I A i)"
	+ unfolding vcinjection_arrow_def by auto
	+ show "vcard (vcinjection_arrow I A i) = 3\<^sub>\<nat>"
	+ unfolding vcinjection_arrow_def by (simp add: nat_omega_simps)
	+ show "vcinjection_arrow I A i\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vcinjection_arrow_components
	+ proof-
	+ from assms(1) have Ai_def: "A i = VLambda I A\<lparr>i\<rparr>" by simp
	+ with assms(1) have "A i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I A)" by auto
	+ with assms(2) Limit_\<alpha> show "A i \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding Ai_def by (auto intro: vrange_in_VsetI)
	+ qed
	+ show "vcinjection_arrow I A i\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding vcinjection_arrow_components
	+ by (intro Limit_vdunion_in_Vset_if_VLambda_in_VsetI Limit_\<alpha> assms)
	+qed
	+ (
	+ auto
	+ simp: vcinjection_arrow_components
	+ intro!: assms vcinjection_vrange_vsubset
	+ )
	+
	+lemma (in \<Z>) vcinjection_arrow_is_arr:
	+ assumes "i \<in>\<^sub>\<circ> I" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "vcinjection_arrow I A i : A i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+proof(intro cat_Set_is_arrI)
	+ from assms show "arr_Set \<alpha> (vcinjection_arrow I A i)"
	+ by (rule arr_Set_vcinjection_arrow)
	+qed (simp_all add: vcinjection_arrow_components)
	+
	+lemma (in \<Z>) vcinjection_arrow_is_arr'[cat_cs_intros]:
	+ assumes "i \<in>\<^sub>\<circ> I"
	+ and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "A' = A i"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ and "P' = (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+ shows "vcinjection_arrow I A i : A' \<mapsto>\<^bsub>\<CC>'\<^esub> P'"
	+ using assms(1,2) unfolding assms(3-5) by (rule vcinjection_arrow_is_arr)
	+
	+
	+
	subsection\<open>Product arrow value for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	-definition prod_2_Rel_ArrVal :: "V \<Rightarrow> V \<Rightarrow> V"
	+definition prod_2_Rel_ArrVal :: "V \<Rightarrow> V \<Rightarrow> V"
	where "prod_2_Rel_ArrVal S T =
	set {\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle> \| a b c d. \<langle>a, c\<rangle> \<in>\<^sub>\<circ> S \<and> \<langle>b, d\<rangle> \<in>\<^sub>\<circ> T}"

	lemma small_prod_2_Rel_ArrVal[simp]:
	"small {\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle> \| a b c d. \<langle>a, c\<rangle> \<in>\<^sub>\<circ> S \<and> \<langle>b, d\<rangle> \<in>\<^sub>\<circ> T}"
	(is \<open>small ?S\<close>)
	proof(rule down)
	show "?S \<subseteq> elts ((\<D>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> T) \<times>\<^sub>\<circ> (\<R>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> T))" by auto
	qed


	text\<open>Rules.\<close>

	lemma prod_2_Rel_ArrValI:
	assumes "ab_cd = \<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle>"
	and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S"
	and "\<langle>b, d\<rangle> \<in>\<^sub>\<circ> T"
	shows "ab_cd \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	using assms unfolding prod_2_Rel_ArrVal_def by simp

	lemma prod_2_Rel_ArrValD[dest]:
	assumes "\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	shows "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S" and "\<langle>b, d\<rangle> \<in>\<^sub>\<circ> T"
	using assms unfolding prod_2_Rel_ArrVal_def by auto

	-lemma prod_2_Rel_ArrValE[elim]:
	+lemma prod_2_Rel_ArrValE[elim!]:
	assumes "ab_cd \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	obtains a b c d where "ab_cd = \<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle>"
	and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S"
	and "\<langle>b, d\<rangle> \<in>\<^sub>\<circ> T"
	using assms unfolding prod_2_Rel_ArrVal_def by auto


	text\<open>Elementary properties\<close>

	lemma prod_2_Rel_ArrVal_vsubset_vprod:
	"prod_2_Rel_ArrVal S T \<subseteq>\<^sub>\<circ> ((\<D>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> T) \<times>\<^sub>\<circ> (\<R>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> T))"
	- by auto
	+ by (intro vsubsetI) auto

	lemma prod_2_Rel_ArrVal_vbrelation: "vbrelation (prod_2_Rel_ArrVal S T)"
	using prod_2_Rel_ArrVal_vsubset_vprod by auto

	lemma prod_2_Rel_ArrVal_vdomain: "\<D>\<^sub>\<circ> (prod_2_Rel_ArrVal S T) = \<D>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> T"
	proof(intro vsubset_antisym)
	show "\<D>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> T \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (prod_2_Rel_ArrVal S T)"
	proof(intro vsubsetI)
	fix ab assume "ab \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> T"
	then obtain a b
	where ab_def: "ab = \<langle>a, b\<rangle>"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> S"
	and "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> T"
	by auto
	then obtain c d where "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S" and "\<langle>b, d\<rangle> \<in>\<^sub>\<circ> T" by force
	then have "\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	by (intro prod_2_Rel_ArrValI) auto
	then show "ab \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (prod_2_Rel_ArrVal S T)"
	- unfolding ab_def by auto
	+ unfolding ab_def by (simp add: app_vdomainI)
	qed
	qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)

	lemma prod_2_Rel_ArrVal_vrange: "\<R>\<^sub>\<circ> (prod_2_Rel_ArrVal S T) = \<R>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> T"
	proof(intro vsubset_antisym)
	show "\<R>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> T \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (prod_2_Rel_ArrVal S T)"
	proof(intro vsubsetI)
	fix cd assume "cd \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> S \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> T"
	then obtain c d
	where cd_def: "cd = \<langle>c, d\<rangle>"
	and "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> S"
	and "d \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> T"
	by auto
	then obtain a b where "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S" and "\<langle>b, d\<rangle> \<in>\<^sub>\<circ> T" by force
	then have "\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	by (intro prod_2_Rel_ArrValI) auto
	then show "cd \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (prod_2_Rel_ArrVal S T)"
	- unfolding cd_def by auto
	+ unfolding cd_def by (simp add: app_vrangeI)
	qed
	qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)


	subsubsection\<open>Further properties\<close>

	lemma
	assumes "vsv g" and "vsv f"
	shows prod_2_Rel_ArrVal_vsv: "vsv (prod_2_Rel_ArrVal g f)"
	and prod_2_Rel_ArrVal_app:
	"\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g; b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f \<rbrakk> \<Longrightarrow>
	prod_2_Rel_ArrVal g f\<lparr>\<langle>a,b\<rangle>\<rparr> = \<langle>g\<lparr>a\<rparr>, f\<lparr>b\<rparr>\<rangle>"
	proof-
	interpret g: vsv g by (rule assms(1))
	interpret f: vsv f by (rule assms(2))
	show vsv_gf: "vsv (prod_2_Rel_ArrVal g f)"
	by (intro vsvI; (elim prod_2_Rel_ArrValE)?; (unfold prod_2_Rel_ArrVal_def)?)
	(auto simp: g.vsv f.vsv)
	fix a b assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g" "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	then have a_ga: "\<langle>a, g\<lparr>a\<rparr>\<rangle> \<in>\<^sub>\<circ> g" and b_fb: "\<langle>b, f\<lparr>b\<rparr>\<rangle> \<in>\<^sub>\<circ> f" by auto
	from a_ga b_fb show "prod_2_Rel_ArrVal g f\<lparr>\<langle>a, b\<rangle>\<rparr> = \<langle>g\<lparr>a\<rparr>, f\<lparr>b\<rparr>\<rangle>"
	by
	(
	cs_concl cs_shallow
	cs_simp: vsv.vsv_appI[OF vsv_gf] cs_intro: prod_2_Rel_ArrValI
	)
	qed

	lemma prod_2_Rel_ArrVal_v11:
	assumes "v11 g" and "v11 f"
	shows "v11 (prod_2_Rel_ArrVal g f)"
	proof-
	interpret g: v11 g by (rule assms(1))
	interpret f: v11 f by (rule assms(2))
	show ?thesis
	proof
	(
	intro vsv.vsv_valeq_v11I prod_2_Rel_ArrVal_vsv g.vsv_axioms f.vsv_axioms,
	unfold prod_2_Rel_ArrVal_vdomain
	)
	fix ab cd
	assume prems:
	"ab \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	"cd \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	"prod_2_Rel_ArrVal g f\<lparr>ab\<rparr> = prod_2_Rel_ArrVal g f\<lparr>cd\<rparr>"
	from prems(1) obtain a b
	where ab_def: "ab = \<langle>a, b\<rangle>" and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g" and b: "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	by auto
	from prems(2) obtain c d
	where cd_def: "cd = \<langle>c, d\<rangle>" and c: "c \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> g" and d: "d \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	by auto
	from prems(3) a b c d have "\<langle>g\<lparr>a\<rparr>, f\<lparr>b\<rparr>\<rangle> = \<langle>g\<lparr>c\<rparr>, f\<lparr>d\<rparr>\<rangle>"
	unfolding ab_def cd_def
	by
	(
	cs_prems cs_shallow
	cs_simp: prod_2_Rel_ArrVal_app cs_intro: V_cs_intros
	)
	then have "g\<lparr>a\<rparr> = g\<lparr>c\<rparr>" and "f\<lparr>b\<rparr> = f\<lparr>d\<rparr>" by simp_all
	then show "ab = cd"
	by (auto simp: ab_def cd_def a b c d f.v11_injective g.v11_injective)
	qed
	qed

	lemma prod_2_Rel_ArrVal_vcomp:
	"prod_2_Rel_ArrVal S' T' \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal S T =
	prod_2_Rel_ArrVal (S' \<circ>\<^sub>\<circ> S) (T' \<circ>\<^sub>\<circ> T)"
	proof-
	interpret ST': vbrelation \<open>prod_2_Rel_ArrVal S' T'\<close>
	by (rule prod_2_Rel_ArrVal_vbrelation)
	interpret ST: vbrelation \<open>prod_2_Rel_ArrVal S T\<close>
	by (rule prod_2_Rel_ArrVal_vbrelation)
	show ?thesis (TODO: simplify proof)
	proof(intro vsubset_antisym vsubsetI)
	fix aa'_cc' assume
	"aa'_cc' \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S' T' \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	then obtain aa' bb' cc' where ac_def: "aa'_cc' = \<langle>aa', cc'\<rangle>"
	and bc: "\<langle>bb', cc'\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S' T'"
	and ab: "\<langle>aa', bb'\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	- by auto
	+ by (elim vcompE)
	from bc obtain b b' c c'
	where bb'_cc'_def: "\<langle>bb', cc'\<rangle> = \<langle>\<langle>b, b'\<rangle>, \<langle>c, c'\<rangle>\<rangle>"
	and bc: "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> S'"
	and bc': "\<langle>b', c'\<rangle> \<in>\<^sub>\<circ> T'"
	by auto
	with ab obtain a a'
	where aa'_bb'_def: "\<langle>aa', bb'\<rangle> = \<langle>\<langle>a, a'\<rangle>, \<langle>b, b'\<rangle>\<rangle>"
	and ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> S"
	and ab': "\<langle>a', b'\<rangle> \<in>\<^sub>\<circ> T"
	by auto
	from bb'_cc'_def have bb'_def: "bb' = \<langle>b, b'\<rangle>" and cc'_def: "cc' = \<langle>c, c'\<rangle>"
	by simp_all
	from aa'_bb'_def have aa'_def: "aa' = \<langle>a, a'\<rangle>" and bb'_def: "bb' = \<langle>b, b'\<rangle>"
	by simp_all
	from bc bc' ab ab' show "aa'_cc' \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (S' \<circ>\<^sub>\<circ> S) (T' \<circ>\<^sub>\<circ> T)"
	unfolding ac_def aa'_def cc'_def
	by (intro prod_2_Rel_ArrValI)
	(cs_concl cs_shallow cs_intro: prod_2_Rel_ArrValI vcompI)+
	next
	fix aa'_cc' assume "aa'_cc' \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (S' \<circ>\<^sub>\<circ> S) (T' \<circ>\<^sub>\<circ> T)"
	then obtain a a' c c'
	where aa'_cc'_def: "aa'_cc' = \<langle>\<langle>a, a'\<rangle>, \<langle>c, c'\<rangle>\<rangle>"
	and ac: "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S' \<circ>\<^sub>\<circ> S"
	and ac': "\<langle>a', c'\<rangle> \<in>\<^sub>\<circ> T' \<circ>\<^sub>\<circ> T"
	by blast
	from ac obtain b where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> S" and bc: "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> S'"
	by auto
	from ac' obtain b' where ab': "\<langle>a', b'\<rangle> \<in>\<^sub>\<circ> T" and bc': "\<langle>b', c'\<rangle> \<in>\<^sub>\<circ> T'"
	by auto
	from ab bc ab' bc' show
	"aa'_cc' \<in>\<^sub>\<circ> prod_2_Rel_ArrVal S' T' \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal S T"
	unfolding aa'_cc'_def
	by (cs_concl cs_shallow cs_intro: vcompI prod_2_Rel_ArrValI)
	qed
	qed

	lemma prod_2_Rel_ArrVal_vid_on[cat_cs_simps]:
	"prod_2_Rel_ArrVal (vid_on A) (vid_on B) = vid_on (A \<times>\<^sub>\<circ> B)"
	unfolding prod_2_Rel_ArrVal_def by auto



	subsection\<open>Product arrow for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	-definition prod_2_Rel :: "V \<Rightarrow> V \<Rightarrow> V"
	+definition prod_2_Rel :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l\<close> 80)
	where "prod_2_Rel S T =
	[
	prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>),
	S\<lparr>ArrDom\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>,
	S\<lparr>ArrCod\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>
	]\<^sub>\<circ>"

	+abbreviation (input) prod_2_Par :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<^sub>A\<times>\<^sub>P\<^sub>a\<^sub>r\<close> 80)
	+ where "prod_2_Par \<equiv> prod_2_Rel"
	+abbreviation (input) prod_2_Set :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t\<close> 80)
	+ where "prod_2_Set \<equiv> prod_2_Rel"
	+

	text\<open>Components.\<close>

	lemma prod_2_Rel_components:
	- shows "prod_2_Rel S T\<lparr>ArrVal\<rparr> = prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>)"
	- and [cat_cs_simps]: "prod_2_Rel S T\<lparr>ArrDom\<rparr> = S\<lparr>ArrDom\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>"
	- and [cat_cs_simps]: "prod_2_Rel S T\<lparr>ArrCod\<rparr> = S\<lparr>ArrCod\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	+ shows "(S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr> = prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>)"
	+ and [cat_cs_simps]: "(S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr> = S\<lparr>ArrDom\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>"
	+ and [cat_cs_simps]: "(S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrCod\<rparr> = S\<lparr>ArrCod\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	unfolding prod_2_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Product arrow for \<open>Rel\<close> is an arrow in \<open>Rel\<close>\<close>

	lemma prod_2_Rel_is_cat_Rel_arr:
	assumes "S : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" and "T : C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> D"
	- shows "prod_2_Rel S T : A \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	+ shows "S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T : A \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	proof-
	note S = cat_Rel_is_arrD[OF assms(1)]
	note T = cat_Rel_is_arrD[OF assms(2)]
	interpret S: arr_Rel \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A" and [simp]: "S\<lparr>ArrCod\<rparr> = B"
	by (simp_all add: S)
	interpret T: arr_Rel \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = C" and [simp]: "T\<lparr>ArrCod\<rparr> = D"
	by (simp_all add: T)
	show ?thesis
	proof(intro cat_Rel_is_arrI arr_RelI)
	- show "vfsequence (prod_2_Rel S T)"
	+ show "vfsequence (S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)"
	unfolding prod_2_Rel_def by simp
	- show "vcard (prod_2_Rel S T) = 3\<^sub>\<nat>"
	+ show "vcard (S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T) = 3\<^sub>\<nat>"
	unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
	from S have "\<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A" and "\<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> B" by auto
	moreover from T have "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> C" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> D"
	by auto
	ultimately have
	"\<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> C"
	"\<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> B \<times>\<^sub>\<circ> D"
	by auto
	then show
	- "\<D>\<^sub>\<circ> (prod_2_Rel S T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> prod_2_Rel S T\<lparr>ArrDom\<rparr>"
	- "\<R>\<^sub>\<circ> (prod_2_Rel S T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> prod_2_Rel S T\<lparr>ArrCod\<rparr>"
	+ "\<D>\<^sub>\<circ> ((S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr>"
	+ "\<R>\<^sub>\<circ> ((S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrCod\<rparr>"
	unfolding
	prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
	by (force simp: prod_2_Rel_components)+
	from
	S.arr_Rel_ArrDom_in_Vset T.arr_Rel_ArrDom_in_Vset
	S.arr_Rel_ArrCod_in_Vset T.arr_Rel_ArrCod_in_Vset
	- show "prod_2_Rel S T\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" "prod_2_Rel S T\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ show "(S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" "(S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding prod_2_Rel_components
	by (all\<open>intro Limit_vtimes_in_VsetI\<close>) auto
	qed (auto simp: prod_2_Rel_components intro: prod_2_Rel_ArrVal_vbrelation)
	qed

	lemma prod_2_Rel_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
	assumes "S : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	and "T : C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> D"
	and "A' = A \<times>\<^sub>\<circ> C"
	and "B' = B \<times>\<^sub>\<circ> D"
	and "\<CC>' = cat_Rel \<alpha>"
	- shows "prod_2_Rel S T : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ shows "S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Rel_arr)


	subsubsection\<open>Product arrow for \<open>Rel\<close> is an arrow in \<open>Set\<close>\<close>

	lemma prod_2_Rel_app[cat_rel_par_Set_cs_simps]:
	assumes "S : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "T : C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> D"
	and "a \<in>\<^sub>\<circ> A"
	and "c \<in>\<^sub>\<circ> C"
	and "ac = \<langle>a, c\<rangle>"
	- shows "prod_2_Rel S T\<lparr>ArrVal\<rparr>\<lparr>ac\<rparr> = \<langle>S\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>, T\<lparr>ArrVal\<rparr>\<lparr>c\<rparr>\<rangle>"
	+ shows "(S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrVal\<rparr>\<lparr>ac\<rparr> = \<langle>S\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>, T\<lparr>ArrVal\<rparr>\<lparr>c\<rparr>\<rangle>"
	proof-
	note S = cat_Set_is_arrD[OF assms(1)]
	note T = cat_Set_is_arrD[OF assms(2)]
	interpret S: arr_Set \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A" and [simp]: "S\<lparr>ArrCod\<rparr> = B"
	by (simp_all add: S)
	interpret T: arr_Set \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = C" and [simp]: "T\<lparr>ArrCod\<rparr> = D"
	by (simp_all add: T)
	from assms(3,4) show ?thesis
	unfolding prod_2_Rel_components(1) assms(5)
	by
	(
	cs_concl cs_shallow
	cs_simp:
	S.arr_Set_ArrVal_vdomain
	T.arr_Set_ArrVal_vdomain
	prod_2_Rel_ArrVal_app
	cs_intro: V_cs_intros
	)
	qed

	lemma prod_2_Rel_is_cat_Set_arr:
	assumes "S : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "T : C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> D"
	- shows "prod_2_Rel S T : A \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	+ shows "S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T : A \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	proof-

	note S = cat_Set_is_arrD[OF assms(1)]
	note T = cat_Set_is_arrD[OF assms(2)]

	interpret S: arr_Set \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A" and [simp]: "S\<lparr>ArrCod\<rparr> = B"
	by (simp_all add: S)
	interpret T: arr_Set \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = C" and [simp]: "T\<lparr>ArrCod\<rparr> = D"
	by (simp_all add: T)

	show ?thesis
	proof(intro cat_Set_is_arrI arr_SetI)
	- show "vfsequence (prod_2_Rel S T)"
	+ show "vfsequence (S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)"
	unfolding prod_2_Rel_def by simp
	- show "vcard (prod_2_Rel S T) = 3\<^sub>\<nat>"
	+ show "vcard (S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T) = 3\<^sub>\<nat>"
	unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
	from S.arr_Set_ArrVal_vrange T.arr_Set_ArrVal_vrange show
	- "\<R>\<^sub>\<circ> (prod_2_Rel S T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> prod_2_Rel S T\<lparr>ArrCod\<rparr>"
	+ "\<R>\<^sub>\<circ> ((S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrCod\<rparr>"
	unfolding
	prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
	by auto
	from assms S.arr_Par_ArrDom_in_Vset T.arr_Par_ArrDom_in_Vset show
	- "prod_2_Rel S T\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ "(S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	from assms S.arr_Par_ArrCod_in_Vset T.arr_Par_ArrCod_in_Vset show
	- "prod_2_Rel S T\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ "(S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	- from assms show "prod_2_Rel S T\<lparr>ArrDom\<rparr> = A \<times>\<^sub>\<circ> C"
	+ from assms show "(S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrDom\<rparr> = A \<times>\<^sub>\<circ> C"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from assms show "prod_2_Rel S T\<lparr>ArrCod\<rparr> = B \<times>\<^sub>\<circ> D"
	+ from assms show "(S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrCod\<rparr> = B \<times>\<^sub>\<circ> D"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- show "vsv (prod_2_Rel S T\<lparr>ArrVal\<rparr>)"
	+ show "vsv ((S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrVal\<rparr>)"
	unfolding prod_2_Rel_components
	by (intro prod_2_Rel_ArrVal_vsv S.ArrVal.vsv_axioms T.ArrVal.vsv_axioms)
	qed
	(
	auto simp:
	cat_cs_simps cat_Set_cs_simps
	prod_2_Rel_ArrVal_vdomain prod_2_Rel_components(1)
	)

	qed

	lemma prod_2_Rel_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "S : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "T : C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> D"
	and "AC = A \<times>\<^sub>\<circ> C"
	and "BD = B \<times>\<^sub>\<circ> D"
	and "\<CC>' = cat_Set \<alpha>"
	- shows "prod_2_Rel S T : AC \<mapsto>\<^bsub>\<CC>'\<^esub> BD"
	+ shows "S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T : AC \<mapsto>\<^bsub>\<CC>'\<^esub> BD"
	using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Set_arr)


	subsubsection\<open>Product arrow for \<open>Rel\<close> is an isomorphism in \<open>Set\<close>\<close>

	-lemma prod_2_Rel_is_cat_Set_arr_isomorphism:
	+lemma prod_2_Rel_is_cat_Set_iso_arr:
	assumes "S : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B" and "T : C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> D"
	- shows "prod_2_Rel S T : A \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	+ shows "S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T : A \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B \<times>\<^sub>\<circ> D"
	proof-
	- note S = cat_Set_is_arr_isomorphismD[OF assms(1)]
	- note T = cat_Set_is_arr_isomorphismD[OF assms(2)]
	+ note S = cat_Set_is_iso_arrD[OF assms(1)]
	+ note T = cat_Set_is_iso_arrD[OF assms(2)]
	show ?thesis
	proof
	(
	- intro cat_Set_is_arr_isomorphismI prod_2_Rel_is_cat_Set_arr[OF S(1) T(1)],
	+ intro cat_Set_is_iso_arrI prod_2_Rel_is_cat_Set_arr[OF S(1) T(1)],
	unfold prod_2_Rel_components
	)
	show "\<D>\<^sub>\<circ> (prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>)) = A \<times>\<^sub>\<circ> C"
	unfolding prod_2_Rel_ArrVal_vdomain
	by (cs_concl cs_shallow cs_simp: S(3) T(3) cs_intro: cat_cs_intros)
	show "\<R>\<^sub>\<circ> (prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>)) = B \<times>\<^sub>\<circ> D"
	unfolding prod_2_Rel_ArrVal_vrange
	by (cs_concl cs_shallow cs_simp: S(4) T(4) cs_intro: cat_cs_intros)
	qed (use S(2) T(2) in \<open>cs_concl cs_shallow cs_intro: prod_2_Rel_ArrVal_v11\<close>)
	qed

	-lemma prod_2_Rel_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
	+lemma prod_2_Rel_is_cat_Set_iso_arr'[cat_rel_par_Set_cs_intros]:
	assumes "S : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	and "T : C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> D"
	and "AC = A \<times>\<^sub>\<circ> C"
	and "BD = B \<times>\<^sub>\<circ> D"
	and "\<CC>' = cat_Set \<alpha>"
	- shows "prod_2_Rel S T : AC \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> BD"
	+ shows "S \<^sub>A\<times>\<^sub>S\<^sub>e\<^sub>t T : AC \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> BD"
	using assms(1,2)
	unfolding assms(3-5)
	- by (rule prod_2_Rel_is_cat_Set_arr_isomorphism)
	+ by (rule prod_2_Rel_is_cat_Set_iso_arr)


	subsubsection\<open>Further elementary properties\<close>

	lemma prod_2_Rel_Comp:
	assumes "G' : B' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B''"
	and "F' : A' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A''"
	and "G : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'"
	and "F : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A'"
	shows
	- "prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F =
	- prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F)"
	+ "G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F =
	+ (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F)"
	proof-

	from cat_Rel_is_arrD(1)[OF assms(1)] interpret \<Z> \<alpha> by auto

	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	note (prefer cat_Rel)[cat_cs_simps] = cat_Rel_is_arrD(2,3)

	from assms have GF'_GF:
	- "prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F :
	+ "G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F :
	B \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'' \<times>\<^sub>\<circ> A''"
	by (cs_concl cs_shallow cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
	from assms Rel.category_axioms have GG'_FF':
	- "prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F) :
	+ "(G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F) :
	B \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'' \<times>\<^sub>\<circ> A''"
	by (cs_concl cs_shallow cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule arr_Rel_eqI[of \<alpha>])
	from GF'_GF show arr_Rel_GF'_GF:
	- "arr_Rel \<alpha> (prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F)"
	+ "arr_Rel \<alpha> (G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F)"
	by (auto dest: cat_Rel_is_arrD(1))
	from GG'_FF' show arr_Rel_GG'_FF':
	- "arr_Rel \<alpha> (prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F))"
	+ "arr_Rel \<alpha> ((G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F))"
	by (auto dest: cat_Rel_is_arrD(1))
	- show "(prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F)\<lparr>ArrVal\<rparr> =
	- prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>"
	+ show "(G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F)\<lparr>ArrVal\<rparr> =
	+ ((G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F))\<lparr>ArrVal\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	fix R assume
	- "R \<in>\<^sub>\<circ> (prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F)\<lparr>ArrVal\<rparr>"
	+ "R \<in>\<^sub>\<circ> (G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F)\<lparr>ArrVal\<rparr>"
	from this assms have "R \<in>\<^sub>\<circ>
	prod_2_Rel_ArrVal (G'\<lparr>ArrVal\<rparr>) (F'\<lparr>ArrVal\<rparr>) \<circ>\<^sub>\<circ>
	prod_2_Rel_ArrVal (G\<lparr>ArrVal\<rparr>) (F\<lparr>ArrVal\<rparr>)"
	by
	(
	cs_prems cs_shallow
	cs_simp:
	prod_2_Rel_components(1)
	comp_Rel_components(1)
	cat_Rel_cs_simps
	cs_intro: cat_Rel_par_set_cs_intros
	)
	from this[unfolded prod_2_Rel_ArrVal_vcomp] assms show
	- "R \<in>\<^sub>\<circ> prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>"
	+ "R \<in>\<^sub>\<circ> ((G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F))\<lparr>ArrVal\<rparr>"
	by
	(
	cs_concl cs_shallow cs_simp:
	prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps
	)
	next
	fix R assume
	- "R \<in>\<^sub>\<circ> prod_2_Rel (G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>"
	+ "R \<in>\<^sub>\<circ> ((G' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> F))\<lparr>ArrVal\<rparr>"
	from this assms have
	"R \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (G'\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> G\<lparr>ArrVal\<rparr>) (F'\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>)"
	by
	(
	cs_prems cs_shallow cs_simp:
	comp_Rel_components prod_2_Rel_components cat_Rel_cs_simps
	)
	from this[folded prod_2_Rel_ArrVal_vcomp] assms show
	- "R \<in>\<^sub>\<circ> (prod_2_Rel G' F' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel G F)\<lparr>ArrVal\<rparr>"
	+ "R \<in>\<^sub>\<circ> ((G' \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F') \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F))\<lparr>ArrVal\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps
	cs_intro: cat_Rel_par_set_cs_intros
	)
	qed

	qed
	(
	use GF'_GF assms in (slow)
	\<open>
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_Rel_cs_intros
	\<close>
	)+

	qed

	lemma (in \<Z>) prod_2_Rel_CId[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows
	- "prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>) = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B\<rparr>"
	+ "(cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>) = cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B\<rparr>"
	proof-
	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	from assms have A_B:
	- "prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>) :
	+ "(cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>) :
	A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> B"
	by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
	from assms Rel.category_axioms have AB:
	"cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B\<rparr> : A \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> B"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cs_intro: V_cs_intros cat_cs_intros
	)
	show ?thesis
	proof(rule arr_Rel_eqI)
	from A_B show arr_Rel_GF'_GF:
	- "arr_Rel \<alpha> (prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>))"
	+ "arr_Rel \<alpha> ((cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>))"
	by (auto dest: cat_Rel_is_arrD(1))
	from AB show arr_Rel_GG'_FF': "arr_Rel \<alpha> (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B\<rparr>)"
	by (auto dest: cat_Rel_is_arrD(1))
	from assms show
	- "prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>)\<lparr>ArrVal\<rparr> =
	+ "((cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>))\<lparr>ArrVal\<rparr> =
	cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B\<rparr>\<lparr>ArrVal\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	id_Rel_components prod_2_Rel_components
	cat_cs_simps cat_Rel_cs_simps
	cs_intro: V_cs_intros cat_cs_intros
	)
	qed
	(
	use A_B assms in
	\<open>
	cs_concl
	cs_simp: prod_2_Rel_components cat_Rel_cs_simps
	cs_intro: cat_cs_intros
	\<close>
	)+
	qed

	-lemma (in \<Z>) cf_dag_Rel_ArrMap_app_prod_2_Rel:
	+lemma cf_dag_Rel_ArrMap_app_prod_2_Rel:
	assumes "S : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" and "T : C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> D"
	shows
	- "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr> =
	- prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)"
	+ "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr> =
	+ (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)"
	proof-

	- interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	+ interpret S: arr_Rel \<alpha> S by (intro cat_Rel_is_arrD[OF assms(1)])
	+ interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule S.category_cat_Rel)
	interpret dag_Rel: is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- by (rule cf_dag_Rel_is_iso_functor)
	+ by (rule S.cf_dag_Rel_is_iso_functor)

	note ST = prod_2_Rel_is_cat_Rel_arr[OF assms]

	from assms have dag_S: "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr> : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A"
	and dag_T: "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : D \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> C"
	by
	(
	cs_concl
	cs_simp: cat_Rel_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)+
	from assms have dag_prod:
	- "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr> : B \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> C"
	+ "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr> : B \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> C"
	by
	(
	cs_concl
	cs_simp: cat_Rel_cs_simps cat_op_simps
	cs_intro: V_cs_intros cat_cs_intros cat_Rel_par_set_cs_intros
	)
	from dag_S dag_T have prod_dag:
	- "prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>) :
	+ "(\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>) :
	B \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> C"
	by (cs_concl cs_shallow cs_intro: cat_Rel_par_set_cs_intros)

	note [cat_cs_simps] =
	prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange prod_2_Rel_components
	from dag_prod ST have [cat_cs_simps]:
	- "\<D>\<^sub>\<circ> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<lparr>ArrVal\<rparr>) =
	- \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	- "\<R>\<^sub>\<circ> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<lparr>ArrVal\<rparr>) =
	- \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	+ "\<D>\<^sub>\<circ> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<lparr>ArrVal\<rparr>) = \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+ "\<R>\<^sub>\<circ> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<lparr>ArrVal\<rparr>) = \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+ by (cs_concl cs_simp: cat_cs_simps)+

	show
	- "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr> =
	- prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)"
	+ "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr> =
	+ (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)"
	proof(rule arr_Rel_eqI)
	from dag_prod show arr_Rel_dag_prod:
	- "arr_Rel \<alpha> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>)"
	+ "arr_Rel \<alpha> (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>)"
	by (auto dest: cat_Rel_is_arrD)
	- then interpret dag_prod: arr_Rel \<alpha> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<close> by simp
	+ then interpret dag_prod: arr_Rel \<alpha> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<close> by simp
	from prod_dag show arr_Rel_prod_dag:
	- "arr_Rel \<alpha> (prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>))"
	+ "arr_Rel \<alpha> ((\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>))"
	by (auto dest: cat_Rel_is_arrD)
	then interpret prod_dag:
	- arr_Rel \<alpha> \<open>prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<close>
	+ arr_Rel \<alpha> \<open>(\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<close>
	by simp
	- from ST have arr_Rel_ST: "arr_Rel \<alpha> (prod_2_Rel S T)"
	+ from ST have arr_Rel_ST: "arr_Rel \<alpha> (S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T)"
	by (auto dest: cat_Rel_is_arrD)
	show
	- "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<lparr>ArrVal\<rparr> =
	- prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<lparr>ArrVal\<rparr>"
	+ "\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<lparr>ArrVal\<rparr> =
	+ ((\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>))\<lparr>ArrVal\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	- fix bd_ac assume prems: "bd_ac \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<lparr>ArrVal\<rparr>"
	+ fix bd_ac assume prems: "bd_ac \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<lparr>ArrVal\<rparr>"
	then obtain bd ac
	where bd_ac_def: "bd_ac = \<langle>bd, ac\<rangle>"
	and bd: "bd \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	and ac: "ac \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>) \<times>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	by (elim cat_Rel_is_arr_ArrValE[OF dag_prod prems, unfolded cat_cs_simps])
	have "\<langle>ac, bd\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (S\<lparr>ArrVal\<rparr>) (T\<lparr>ArrVal\<rparr>)"
	by
	(
	rule prems[
	unfolded
	bd_ac_def
	cf_dag_Rel_ArrMap_app_iff[OF ST]
	prod_2_Rel_components
	]
	)
	then obtain a b c d
	where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	and cd: "\<langle>c, d\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	and bd_def: "bd = \<langle>b, d\<rangle>"
	and ac_def: "ac = \<langle>a, c\<rangle>"
	by auto
	- show "bd_ac \<in>\<^sub>\<circ> prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<lparr>ArrVal\<rparr>"
	+ show "bd_ac \<in>\<^sub>\<circ> ((\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>))\<lparr>ArrVal\<rparr>"
	unfolding prod_2_Rel_components
	proof(intro prod_2_Rel_ArrValI)
	show "bd_ac = \<langle>\<langle>b, d\<rangle>, \<langle>a, c\<rangle>\<rangle>" unfolding bd_ac_def bd_def ac_def by simp
	from assms ab cd show
	"\<langle>b, a\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>\<lparr>ArrVal\<rparr>"
	"\<langle>d, c\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	qed
	next
	fix bd_ac assume prems:
	- "bd_ac \<in>\<^sub>\<circ> prod_2_Rel (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>)\<lparr>ArrVal\<rparr>"
	+ "bd_ac \<in>\<^sub>\<circ> ((\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>))\<lparr>ArrVal\<rparr>"
	then obtain a b c d
	where bd_ac_def: "bd_ac = \<langle>\<langle>b, d\<rangle>, a, c\<rangle>"
	and ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>\<lparr>ArrVal\<rparr>"
	and dc: "\<langle>d, c\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>"
	by (elim prod_2_Rel_ArrValE[OF prems[unfolded prod_2_Rel_components]])
	then have ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" and cd: "\<langle>c, d\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	unfolding assms[THEN cf_dag_Rel_ArrMap_app_iff] by simp_all
	- from ST ab cd show "bd_ac \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>prod_2_Rel S T\<rparr>\<lparr>ArrVal\<rparr>"
	+ from ST ab cd show "bd_ac \<in>\<^sub>\<circ> \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l T\<rparr>\<lparr>ArrVal\<rparr>"
	unfolding bd_ac_def
	by
	(
	cs_concl cs_shallow
	cs_simp: prod_2_Rel_components cat_cs_simps
	cs_intro: prod_2_Rel_ArrValI cat_cs_intros
	)
	qed
	qed (use dag_prod prod_dag in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+

	qed



	subsection\<open>Product functor for \<open>Rel\<close>\<close>

	definition cf_prod_2_Rel :: "V \<Rightarrow> V"
	where "cf_prod_2_Rel \<AA> =
	[
	(\<lambda>AB\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>. AB\<lparr>0\<rparr> \<times>\<^sub>\<circ> AB\<lparr>1\<^sub>\<nat>\<rparr>),
	- (\<lambda>ST\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>. prod_2_Rel (ST\<lparr>0\<rparr>) (ST\<lparr>1\<^sub>\<nat>\<rparr>)),
	+ (\<lambda>ST\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>. (ST\<lparr>0\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (ST\<lparr>1\<^sub>\<nat>\<rparr>)),
	\<AA> \<times>\<^sub>C \<AA>,
	\<AA>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_prod_2_Rel_components:
	shows "cf_prod_2_Rel \<AA>\<lparr>ObjMap\<rparr> = (\<lambda>AB\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>. AB\<lparr>0\<rparr> \<times>\<^sub>\<circ> AB\<lparr>1\<^sub>\<nat>\<rparr>)"
	and "cf_prod_2_Rel \<AA>\<lparr>ArrMap\<rparr> =
	- (\<lambda>ST\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>. prod_2_Rel (ST\<lparr>0\<rparr>) (ST\<lparr>1\<^sub>\<nat>\<rparr>))"
	+ (\<lambda>ST\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>. (ST\<lparr>0\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (ST\<lparr>1\<^sub>\<nat>\<rparr>))"
	and [cat_cs_simps]: "cf_prod_2_Rel \<AA>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C \<AA>"
	and [cat_cs_simps]: "cf_prod_2_Rel \<AA>\<lparr>HomCod\<rparr> = \<AA>"
	unfolding cf_prod_2_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda cf_prod_2_Rel_components(1)
	\|vsv cf_prod_2_Rel_ObjMap_vsv[cat_cs_intros]\|
	\|vdomain cf_prod_2_Rel_ObjMap_vdomain[cat_cs_simps]\|

	lemma cf_prod_2_Rel_ObjMap_app[cat_cs_simps]:
	assumes "AB = [A, B]\<^sub>\<circ>" and "AB \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
	shows "A \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>cf_prod_2_Rel \<AA>\<^esub> B = A \<times>\<^sub>\<circ> B"
	using assms(2)
	unfolding assms(1) cf_prod_2_Rel_components
	by (simp add: nat_omega_simps)

	lemma (in \<Z>) cf_prod_2_Rel_ObjMap_vrange:
	"\<R>\<^sub>\<circ> (cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	proof-
	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Rel_cs_intros)
	show ?thesis
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
	fix AB assume prems: "AB \<in>\<^sub>\<circ> (cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>)\<lparr>Obj\<rparr>"
	with Rel.category_axioms obtain A B where AB_def: "AB = [A, B]\<^sub>\<circ>"
	and A: "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[rotated 2])
	from prems A B show "cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>AB\<rparr> \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	unfolding AB_def cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: V_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	qed


	subsubsection\<open>Arrow map\<close>

	mk_VLambda cf_prod_2_Rel_components(2)
	\|vsv cf_prod_2_Rel_ArrMap_vsv[cat_cs_intros]\|
	\|vdomain cf_prod_2_Rel_ArrMap_vdomain[cat_cs_simps]\|

	lemma cf_prod_2_Rel_ArrMap_app[cat_cs_simps]:
	assumes "GF = [G, F]\<^sub>\<circ>" and "GF \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
	- shows "G \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>cf_prod_2_Rel \<AA>\<^esub> F = prod_2_Rel G F"
	+ shows "G \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>cf_prod_2_Rel \<AA>\<^esub> F = G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F"
	using assms(2)
	unfolding assms(1) cf_prod_2_Rel_components
	by (simp add: nat_omega_simps)


	subsubsection\<open>Product functor for \<open>Rel\<close> is a functor\<close>

	lemma (in \<Z>) cf_prod_2_Rel_is_functor:
	"cf_prod_2_Rel (cat_Rel \<alpha>) : cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof-

	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Rel_cs_intros)

	show ?thesis
	proof(rule is_functorI')
	show "vfsequence (cf_prod_2_Rel (cat_Rel \<alpha>))"
	unfolding cf_prod_2_Rel_def by auto
	show "vcard (cf_prod_2_Rel (cat_Rel \<alpha>)) = 4\<^sub>\<nat>"
	unfolding cf_prod_2_Rel_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	by (rule cf_prod_2_Rel_ObjMap_vrange)
	show "cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>GF\<rparr> :
	cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>AB\<rparr> \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub>
	cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>CD\<rparr>"
	if "GF : AB \<mapsto>\<^bsub>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<^esub> CD" for AB CD GF
	proof-
	from that obtain G F A B C D
	where GF_def: "GF = [G, F]\<^sub>\<circ>"
	and AB_def: "AB = [A, B]\<^sub>\<circ>"
	and CD_def: "CD = [C, D]\<^sub>\<circ>"
	and G: "G : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> C"
	and F: "F : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> D"
	by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
	from that G F show ?thesis
	unfolding GF_def AB_def CD_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro:
	cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
	)
	qed

	show
	"cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>GF' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<^esub> GF\<rparr> =
	cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>GF'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>GF\<rparr>"
	if "GF' : AB' \<mapsto>\<^bsub>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<^esub> AB''"
	and "GF : AB \<mapsto>\<^bsub>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<^esub> AB'"
	for AB' AB'' GF' AB GF
	proof-
	from that(2) obtain G F A A' B B'
	where GF_def: "GF = [G, F]\<^sub>\<circ>"
	and AB_def: "AB = [A, B]\<^sub>\<circ>"
	and AB'_def: "AB' = [A', B']\<^sub>\<circ>"
	and G: "G : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A'"
	and F: "F : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'"
	by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
	with that(1) obtain G' F' A'' B''
	where GF'_def: "GF' = [G', F']\<^sub>\<circ>"
	and AB''_def: "AB'' = [A'', B'']\<^sub>\<circ>"
	and G': "G' : A' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A''"
	and F': "F' : B' \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B''"
	by
	(
	auto elim:
	cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms]
	)
	from that G F G' F' show ?thesis
	unfolding GF_def AB_def AB'_def GF'_def AB''_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_prod_cs_simps prod_2_Rel_Comp
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed

	show
	"cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>(cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>)\<lparr>CId\<rparr>\<lparr>AB\<rparr>\<rparr> =
	cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>cf_prod_2_Rel (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>AB\<rparr>\<rparr>"
	if "AB \<in>\<^sub>\<circ> (cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>)\<lparr>Obj\<rparr>" for AB
	proof-
	from that obtain A B
	where AB_def: "AB = [A, B]\<^sub>\<circ>"
	and A: "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF Rel.category_axioms Rel.category_axioms])
	from A B show ?thesis
	unfolding AB_def
	by
	(
	cs_concl
	cs_simp:
	cf_prod_2_Rel_ObjMap_app cf_prod_2_Rel_ArrMap_app
	cat_cs_simps cat_prod_cs_simps
	cs_intro:
	V_cs_intros cat_cs_intros cat_Rel_cs_intros cat_prod_cs_intros
	)
	qed

	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_cs_intros cat_Rel_cs_intros
	)+

	qed

	lemma (in \<Z>) cf_prod_2_Rel_is_functor'[cat_cs_intros]:
	assumes "\<AA>' = cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>"
	and "\<BB>' = cat_Rel \<alpha>"
	and "\<alpha>' = \<alpha>"
	shows "cf_prod_2_Rel (cat_Rel \<alpha>) : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule cf_prod_2_Rel_is_functor)

	lemmas [cat_cs_intros] = \<Z>.cf_prod_2_Rel_is_functor'



	subsection\<open>Product universal property arrow for \<open>Set\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cat_Set_obj_prod_up :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "cat_Set_obj_prod_up I F A \<phi> =
	[(\<lambda>a\<in>\<^sub>\<circ>A. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)), A, (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_Set_obj_prod_up_components:
	shows "cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>A. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>))"
	and [cat_Set_cs_simps]:
	"cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrDom\<rparr> = A"
	and [cat_Set_cs_simps]:
	"cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrCod\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	unfolding cat_Set_obj_prod_up_def arr_field_simps
	by (simp_all add: nat_omega_simps)


	-text\<open>Arrow value.\<close>
	+subsubsection\<open>Arrow value\<close>

	mk_VLambda cat_Set_obj_prod_up_components(1)
	\|vsv cat_Set_obj_prod_up_ArrVal_vsv[cat_Set_cs_intros]\|
	\|vdomain cat_Set_obj_prod_up_ArrVal_vdomain[cat_Set_cs_simps]\|
	\|app cat_Set_obj_prod_up_ArrVal_app\|

	lemma cat_Set_obj_prod_up_ArrVal_vrange:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	shows "\<R>\<^sub>\<circ> (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	unfolding cat_Set_obj_prod_up_components
	proof(intro vrange_VLambda_vsubset vproductI)
	fix a assume prems: "a \<in>\<^sub>\<circ> A"
	show "\<forall>i\<in>\<^sub>\<circ>I. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)\<lparr>i\<rparr> \<in>\<^sub>\<circ> F i"
	proof(intro ballI)
	fix i assume "i \<in>\<^sub>\<circ> I"
	with assms prems show "(\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)\<lparr>i\<rparr> \<in>\<^sub>\<circ> F i"
	by (cs_concl cs_shallow cs_simp: V_cs_simps cs_intro: cat_Set_cs_intros)
	qed
	qed auto

	lemma cat_Set_obj_prod_up_ArrVal_app_vdomain[cat_Set_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "\<D>\<^sub>\<circ> (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) = I"
	unfolding cat_Set_obj_prod_up_ArrVal_app[OF assms] by simp

	lemma cat_Set_obj_prod_up_ArrVal_app_component[cat_Set_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> A" and "i \<in>\<^sub>\<circ> I"
	shows "cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> = \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	using assms
	by (cs_concl cs_shallow cs_simp: cat_Set_obj_prod_up_ArrVal_app V_cs_simps)

	lemma cat_Set_obj_prod_up_ArrVal_app_vrange:
	assumes "a \<in>\<^sub>\<circ> A" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	shows "\<R>\<^sub>\<circ> (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	proof(intro vsubsetI)
	fix b assume prems: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)"
	from assms(1) have "vsv (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)"
	by (auto simp: cat_Set_obj_prod_up_components)
	with prems obtain i
	where b_def: "b = cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr>"
	and i: "i \<in>\<^sub>\<circ> I"
	by
	(
	auto
	elim: vsv.vrange_atE
	simp: cat_Set_obj_prod_up_ArrVal_app[OF assms(1)]
	)
	from cat_Set_obj_prod_up_ArrVal_app_component[OF assms(1) i] b_def have b_def':
	"b = \<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	by simp
	from assms(1) assms(2)[OF i] have "b \<in>\<^sub>\<circ> F i"
	unfolding b_def' by (cs_concl cs_shallow cs_intro: cat_Set_cs_intros)
	with i show "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)" by force
	qed


	subsubsection\<open>Product universal property arrow for \<open>Set\<close> is an arrow in \<open>Set\<close>\<close>

	lemma (in \<Z>) cat_Set_obj_prod_up_cat_Set_is_arr:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	shows "cat_Set_obj_prod_up I F A \<phi> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	proof(intro cat_Set_is_arrI arr_SetI)
	show "vfsequence (cat_Set_obj_prod_up I F A \<phi>)"
	unfolding cat_Set_obj_prod_up_def by auto
	show "vcard (cat_Set_obj_prod_up I F A \<phi>) = 3\<^sub>\<nat>"
	unfolding cat_Set_obj_prod_up_def by (auto simp: nat_omega_simps)
	show
	"\<R>\<^sub>\<circ> (cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrCod\<rparr>"
	unfolding cat_Set_obj_prod_up_components(3)
	by (rule cat_Set_obj_prod_up_ArrVal_vrange[OF assms(3)])
	show "cat_Set_obj_prod_up I F A \<phi>\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding cat_Set_cs_simps
	by (rule Limit_vproduct_in_Vset_if_VLambda_in_VsetI)
	(simp_all add: cat_Set_cs_simps assms)
	-qed (auto simp: assms cat_Set_cs_simps intro: cat_Set_cs_intros)
	+qed
	+ (
	+ auto
	+ simp: assms[unfolded cat_Set_components(1)] cat_Set_cs_simps
	+ intro: cat_Set_cs_intros
	+ )
	+
	+
	+subsubsection\<open>Further properties\<close>

	lemma (in \<Z>) cat_Set_cf_comp_proj_obj_prod_up:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	and "i \<in>\<^sub>\<circ> I"
	shows
	"\<phi> i = vprojection_arrow I F i \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_obj_prod_up I F A \<phi>"
	(is \<open>\<phi> i = ?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>\<close>)
	proof(rule arr_Set_eqI[of \<alpha>])
	note \<phi>i = assms(3)[OF assms(4)]
	note \<phi>i = cat_Set_is_arrD[OF \<phi>i] \<phi>i
	have Fi: "?Fi : (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	by (rule vprojection_arrow_is_arr[OF assms(4,2)])
	from cat_Set_obj_prod_up_cat_Set_is_arr[OF assms(1,2,3)] have \<phi>:
	"cat_Set_obj_prod_up I F A \<phi> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	by simp
	show "arr_Set \<alpha> (\<phi> i)" by (rule \<phi>i(1))
	interpret \<phi>i: arr_Set \<alpha> \<open>\<phi> i\<close> by (rule \<phi>i(1))
	from Fi \<phi> have Fi_\<phi>: "?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	then show arr_Set_Fi_\<phi>: "arr_Set \<alpha> (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)"
	by (auto simp: cat_Set_is_arrD(1))
	interpret arr_Set \<alpha> \<open>?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>\<close> by (rule arr_Set_Fi_\<phi>)
	from \<phi>i have dom_lhs: "\<D>\<^sub>\<circ> (\<phi> i\<lparr>ArrVal\<rparr>) = A"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from Fi_\<phi> have dom_rhs: "\<D>\<^sub>\<circ> ((?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrVal\<rparr>) = A"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<phi> i\<lparr>ArrVal\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> A"
	from assms(4) prems \<phi>i(4) \<phi> Fi show
	"\<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_cs_simps cat_cs_simps
	cs_intro: cat_Set_cs_intros cat_cs_intros
	)
	qed auto
	- from Fi \<phi> show "\<phi> i\<lparr>ArrDom\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrDom\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_Set_cs_simps \<phi>i(2))
	- from Fi \<phi> show "\<phi> i\<lparr>ArrCod\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrCod\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_Set_cs_simps \<phi>i(3))
	+ from Fi \<phi> show
	+ "\<phi> i\<lparr>ArrDom\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrDom\<rparr>"
	+ "\<phi> i\<lparr>ArrCod\<rparr> = (?Fi \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>)\<lparr>ArrCod\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_Set_cs_simps \<phi>i(2,3))+
	+qed
	+
	+
	+
	+subsection\<open>Coproduct universal property arrow for \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition cat_Set_obj_coprod_up :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "cat_Set_obj_coprod_up I F A \<phi> =
	+ [(\<lambda>ix\<in>\<^sub>\<circ>(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i). \<phi> (vfst ix)\<lparr>ArrVal\<rparr>\<lparr>vsnd ix\<rparr>), (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i), A]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma cat_Set_obj_coprod_up_components:
	+ shows "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrVal\<rparr> =
	+ (\<lambda>ix\<in>\<^sub>\<circ>(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i). \<phi> (vfst ix)\<lparr>ArrVal\<rparr>\<lparr>vsnd ix\<rparr>)"
	+ and [cat_Set_cs_simps]:
	+ "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrDom\<rparr> = (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ and [cat_Set_cs_simps]:
	+ "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrCod\<rparr> = A"
	+ unfolding cat_Set_obj_coprod_up_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+mk_VLambda cat_Set_obj_coprod_up_components(1)
	+ \|vsv cat_Set_obj_coprod_up_ArrVal_vsv[cat_Set_cs_intros]\|
	+ \|vdomain cat_Set_obj_coprod_up_ArrVal_vdomain[cat_Set_cs_simps]\|
	+ \|app cat_Set_obj_coprod_up_ArrVal_app'\|
	+
	+lemma cat_Set_obj_coprod_up_ArrVal_app[cat_cs_simps]:
	+ assumes "ix = \<langle>i, x\<rangle>" and "\<langle>i, x\<rangle> \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ shows "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>ix\<rparr> = \<phi> i\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ using assms by (auto simp: cat_Set_obj_coprod_up_ArrVal_app')
	+
	+lemma cat_Set_obj_coprod_up_ArrVal_vrange:
	+ assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ shows "\<R>\<^sub>\<circ> (cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A"
	+proof
	+ (
	+ intro vsv.vsv_vrange_vsubset cat_Set_obj_coprod_up_ArrVal_vsv,
	+ unfold cat_Set_cs_simps
	+ )
	+ fix ix assume "ix \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ then obtain i x where ix_def: "ix = \<langle>i, x\<rangle>" and i: "i \<in>\<^sub>\<circ> I" and x: "x \<in>\<^sub>\<circ> F i"
	+ by auto
	+ show "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrVal\<rparr>\<lparr>ix\<rparr> \<in>\<^sub>\<circ> A"
	+ proof(cs_concl_step cat_Set_obj_coprod_up_ArrVal_app)
	+ show "ix = \<langle>i, x\<rangle>" by (rule ix_def)
	+ from i x show "\<langle>i, x\<rangle> \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)" by auto
	+ from i x assms[OF i] show "\<phi> i\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> A"
	+ by (auto intro: cat_Set_ArrVal_app_vrange)
	+ qed
	+qed
	+
	+
	+subsubsection\<open>Coproduct universal property arrow for \<open>Set\<close> is an arrow in \<open>Set\<close>\<close>
	+
	+lemma (in \<Z>) cat_Set_obj_coprod_up_cat_Set_is_arr:
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ shows "cat_Set_obj_coprod_up I F A \<phi> : (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+proof(intro cat_Set_is_arrI arr_SetI)
	+ show "vfsequence (cat_Set_obj_coprod_up I F A \<phi>)"
	+ unfolding cat_Set_obj_coprod_up_def by auto
	+ show "vcard (cat_Set_obj_coprod_up I F A \<phi>) = 3\<^sub>\<nat>"
	+ unfolding cat_Set_obj_coprod_up_def by (auto simp: nat_omega_simps)
	+ show
	+ "\<R>\<^sub>\<circ> (cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	+ cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrCod\<rparr>"
	+ unfolding cat_Set_obj_coprod_up_components(3)
	+ by (rule cat_Set_obj_coprod_up_ArrVal_vrange[OF assms(3)])
	+ show "cat_Set_obj_coprod_up I F A \<phi>\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (simp_all add: cat_Set_cs_simps assms[unfolded cat_Set_components(1)])
	+qed
	+ (
	+ auto simp:
	+ assms
	+ cat_Set_obj_coprod_up_components
	+ Limit_vdunion_in_Vset_if_VLambda_in_VsetI
	+ )
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in \<Z>) cat_Set_cf_comp_coprod_up_vcia:
	+ assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ and "i \<in>\<^sub>\<circ> I"
	+ shows
	+ "\<phi> i = cat_Set_obj_coprod_up I F A \<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> vcinjection_arrow I F i"
	+ (is \<open>\<phi> i = ?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi\<close>)
	+proof(rule arr_Set_eqI[of \<alpha>])
	+ note \<phi>i = assms(3)[OF assms(4)]
	+ note \<phi>i = cat_Set_is_arrD[OF \<phi>i] \<phi>i
	+ have Fi: "?Fi : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ by (rule vcinjection_arrow_is_arr[OF assms(4,2)])
	+ from cat_Set_obj_coprod_up_cat_Set_is_arr[OF assms(1,2,3)] have \<phi>:
	+ "cat_Set_obj_coprod_up I F A \<phi> : (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ by simp
	+ show "arr_Set \<alpha> (\<phi> i)" by (rule \<phi>i(1))
	+ then interpret \<phi>i: arr_Set \<alpha> \<open>\<phi> i\<close> .
	+ from Fi \<phi> have Fi_\<phi>: "?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ then show arr_Set_Fi_\<phi>: "arr_Set \<alpha> (?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)"
	+ by (auto simp: cat_Set_is_arrD(1))
	+ interpret arr_Set \<alpha> \<open>?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi\<close> by (rule arr_Set_Fi_\<phi>)
	+ from \<phi>i have dom_lhs: "\<D>\<^sub>\<circ> (\<phi> i\<lparr>ArrVal\<rparr>) = F i"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from Fi_\<phi> have dom_rhs: "\<D>\<^sub>\<circ> ((?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)\<lparr>ArrVal\<rparr>) = F i"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<phi> i\<lparr>ArrVal\<rparr> = (?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> F i"
	+ from assms(4) this \<phi>i(4) \<phi> Fi show
	+ "\<phi> i\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = (?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_Set_cs_simps cat_cs_simps
	+ cs_intro: vdunionI cat_Set_cs_intros cat_cs_intros
	+ )
	+ qed auto
	+ from Fi \<phi> show
	+ "\<phi> i\<lparr>ArrDom\<rparr> = (?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)\<lparr>ArrDom\<rparr>"
	+ "\<phi> i\<lparr>ArrCod\<rparr> = (?\<phi> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Fi)\<lparr>ArrCod\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_Set_cs_simps \<phi>i(2,3))+
	qed



	subsection\<open>Equalizer object for the category \<open>Set\<close>\<close>


	text\<open>
	The definition of the (non-categorical concept of an) equalizer can be
	found in \cite{noauthor_wikipedia_2001}\footnote{
	\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
	}\<close>

	definition vequalizer :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "vequalizer X f g = set {x. x \<in>\<^sub>\<circ> X \<and> f\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>}"

	lemma small_vequalizer[simp]:
	"small {x. x \<in>\<^sub>\<circ> X \<and> f\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>}"
	by auto


	text\<open>Rules.\<close>

	lemma vequalizerI:
	assumes "x \<in>\<^sub>\<circ> X" and "f\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	shows "x \<in>\<^sub>\<circ> vequalizer X f g"
	using assms unfolding vequalizer_def by auto

	lemma vequalizerD[dest]:
	assumes "x \<in>\<^sub>\<circ> vequalizer X f g"
	shows "x \<in>\<^sub>\<circ> X" and "f\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	using assms unfolding vequalizer_def by auto

	lemma vequalizerE[elim]:
	assumes "x \<in>\<^sub>\<circ> vequalizer X f g"
	obtains "x \<in>\<^sub>\<circ> X" and "f\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	using assms unfolding vequalizer_def by auto


	text\<open>Elementary results.\<close>

	lemma vequalizer_vsubset_vdomain[cat_Set_cs_intros]: "vequalizer a g f \<subseteq>\<^sub>\<circ> a"
	by auto

	lemma Limit_vequalizer_in_Vset[cat_Set_cs_intros]:
	- assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	- shows "vequalizer a g f \<in>\<^sub>\<circ> Vset \<alpha>"
	- using assms by auto
	+ assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "vequalizer a g f \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ using assms unfolding cat_Set_components(1) by auto

	lemma vequalizer_flip: "vequalizer a f g = vequalizer a g f"
	unfolding vequalizer_def by auto

	-lemma (in \<Z>) cat_Set_incl_Set_commute:
	+lemma cat_Set_incl_Set_commute:
	assumes "\<gg> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	shows
	"\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer \<aa> \<ff> \<gg>) \<aa> =
	\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer \<aa> \<ff> \<gg>) \<aa>"
	(is \<open>\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl = \<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl\<close>)
	proof-

	- note \<gg> = cat_Set_is_arrD[OF assms(1)]
	interpret \<gg>: arr_Set \<alpha> \<gg>
	rewrites "\<gg>\<lparr>ArrDom\<rparr> = \<aa>" and "\<gg>\<lparr>ArrCod\<rparr> = \<bb>"
	- by (rule \<gg>(1)) (simp_all add: \<gg>)
	- note \<ff> = cat_Set_is_arrD[OF assms(2)]
	+ by (intro cat_Set_is_arrD[OF assms(1)])+
	interpret \<ff>: arr_Set \<alpha> \<ff>
	rewrites "\<ff>\<lparr>ArrDom\<rparr> = \<aa>" and "\<ff>\<lparr>ArrCod\<rparr> = \<bb>"
	- by (rule \<ff>(1)) (simp_all add: \<ff>)
	+ by (intro cat_Set_is_arrD[OF assms(2)])+

	note [cat_Set_cs_intros] = \<gg>.arr_Set_ArrDom_in_Vset \<ff>.arr_Set_ArrCod_in_Vset

	from assms have \<gg>_incl:
	"\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl : vequalizer \<aa> \<ff> \<gg> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	- by (cs_concl cs_shallow cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
	+ by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
	then have dom_lhs: "\<D>\<^sub>\<circ> ((\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr>) = vequalizer \<aa> \<ff> \<gg>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	from assms have \<ff>_incl:
	"\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl : vequalizer \<aa> \<ff> \<gg> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	- by (cs_concl cs_shallow cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
	+ by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> ((\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr>) = vequalizer \<aa> \<ff> \<gg>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)+

	show ?thesis
	proof(rule arr_Set_eqI)
	from \<gg>_incl show arr_Set_\<gg>_incl: "arr_Set \<alpha> (\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	by (auto dest: cat_Set_is_arrD(1))
	interpret arr_Set_\<gg>_incl: arr_Set \<alpha> \<open>\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl\<close>
	by (rule arr_Set_\<gg>_incl)
	from \<ff>_incl show arr_Set_\<ff>_incl: "arr_Set \<alpha> (\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	by (auto dest: cat_Set_is_arrD(1))
	interpret arr_Set_\<ff>_incl: arr_Set \<alpha> \<open>\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl\<close>
	by (rule arr_Set_\<ff>_incl)
	show "(\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr> = (\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> vequalizer \<aa> \<ff> \<gg>"
	with assms show
	"(\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = (\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	- by
	+ by (very slow)
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: vequalizerD(2) cat_Set_cs_simps cat_cs_simps
	cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
	)
	qed auto
	qed (use \<gg>_incl \<ff>_incl in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed



	+subsection\<open>Application of a function to a finite sequence as an arrow in \<open>Set\<close>\<close>
	+
	+definition vfsequence_map :: "V \<Rightarrow> V"
	+ where "vfsequence_map F =
	+ [
	+ (\<lambda>xs\<in>\<^sub>\<circ>vfsequences_on (F\<lparr>ArrDom\<rparr>). F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs),
	+ vfsequences_on (F\<lparr>ArrDom\<rparr>),
	+ vfsequences_on (F\<lparr>ArrCod\<rparr>)
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma vfsequence_map_components:
	+ shows "vfsequence_map F\<lparr>ArrVal\<rparr> =
	+ (\<lambda>xs\<in>\<^sub>\<circ>vfsequences_on (F\<lparr>ArrDom\<rparr>). F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs)"
	+ and [cat_cs_simps]: "vfsequence_map F\<lparr>ArrDom\<rparr> = vfsequences_on (F\<lparr>ArrDom\<rparr>)"
	+ and [cat_cs_simps]: "vfsequence_map F\<lparr>ArrCod\<rparr> = vfsequences_on (F\<lparr>ArrCod\<rparr>)"
	+ unfolding vfsequence_map_def arr_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+mk_VLambda vfsequence_map_components(1)
	+ \|vsv vfsequence_map_ArrVal_vsv[cat_cs_intros, cat_Set_cs_intros]\|
	+ \|vdomain vfsequence_map_ArrVal_vdomain[cat_cs_simps, cat_Set_cs_simps]\|
	+ \|app vfsequence_map_ArrVal_app\|
	+
	+lemma vfsequence_map_ArrVal_app_app:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "xs \<in>\<^sub>\<circ> vfsequences_on A"
	+ and "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs"
	+ shows "vfsequence_map F\<lparr>ArrVal\<rparr>\<lparr>xs\<rparr>\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>xs\<lparr>i\<rparr>\<rparr>"
	+proof-
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret arr_Set \<alpha> F
	+ rewrites "F\<lparr>ArrDom\<rparr> = A" and "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ note xsD = vfsequences_onD[OF assms(2)]
	+ interpret xs: vfsequence xs by (rule xsD(1))
	+ from assms xsD(2)[OF assms(3)] show ?thesis
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps vfsequence_map_ArrVal_app
	+ cs_intro: V_cs_intros
	+ )
	+qed
	+
	+
	+subsubsection\<open>
	+Application of a function to a finite sequence is an arrow in \<open>Set\<close>
	+\<close>
	+
	+lemma vfsequence_map_is_arr:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vfsequence_map F : vfsequences_on A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vfsequences_on B"
	+proof-
	+
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+
	+ show ?thesis
	+ proof(intro cat_Set_is_arrI arr_SetI , unfold cat_cs_simps)
	+ show "vfsequence (vfsequence_map F)"
	+ unfolding vfsequence_map_def by auto
	+ show "vcard (vfsequence_map F) = 3\<^sub>\<nat>"
	+ unfolding vfsequence_map_def by (simp_all add: nat_omega_simps)
	+ show "\<R>\<^sub>\<circ> (vfsequence_map F\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> vfsequences_on B"
	+ unfolding vfsequence_map_components
	+ proof
	+ (
	+ intro vrange_VLambda_vsubset vfsequences_onI;
	+ elim vfsequences_onE;
	+ unfold cat_cs_simps
	+ )
	+ fix xs assume prems: "vfsequence xs" "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A" for i
	+ interpret xs: vfsequence xs by (rule prems(1))
	+ have [intro]: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)" if "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xs" for x
	+ proof-
	+ from that obtain i where i: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" and x_def: "x = xs\<lparr>i\<rparr>"
	+ by (auto dest: xs.vrange_atD)
	+ from prems(2)[OF i] show "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ unfolding x_def arr_Set_ArrVal_vdomain .
	+ qed
	+ show "vfsequence (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs)"
	+ by (intro vfsequence_vcomp_vsv_vfsequence vsubsetI)
	+ (auto intro: prems(1))
	+ fix i assume prems': "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs)"
	+ moreover have "\<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs) = \<D>\<^sub>\<circ> xs"
	+ by (intro vdomain_vcomp_vsubset vsubsetI) (auto intro: prems(1))
	+ ultimately have i: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" by simp
	+ with assms(1) prems(2)[OF i] show "(F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs)\<lparr>i\<rparr> \<in>\<^sub>\<circ> B"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro: V_cs_intros cat_Set_cs_intros
	+ )
	+ qed
	+
	+ qed
	+ (
	+ auto intro:
	+ vfsequences_on_in_VsetI
	+ arr_Set_ArrDom_in_Vset
	+ arr_Set_ArrCod_in_Vset
	+ cat_cs_intros
	+ )
	+
	+qed
	+
	+lemma (in \<Z>) vfsequence_map_is_monic_arr:
	+ assumes "F : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vfsequence_map F : vfsequences_on A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> vfsequences_on B"
	+proof-
	+
	+ note cat_Set_is_monic_arrD[OF assms]
	+ note FD = this cat_Set_is_arrD[OF this(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+
	+ show ?thesis
	+ proof
	+ (
	+ intro cat_Set_is_monic_arrI vfsequence_map_is_arr FD(1) vsv.vsv_valeq_v11I,
	+ unfold cat_cs_simps;
	+ (elim vfsequences_onE)?
	+ )
	+
	+ fix xs ys assume prems:
	+ "vfsequence_map F\<lparr>ArrVal\<rparr>\<lparr>xs\<rparr> = vfsequence_map F\<lparr>ArrVal\<rparr>\<lparr>ys\<rparr>"
	+ "vfsequence xs"
	+ "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+ "vfsequence ys"
	+ "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ys \<Longrightarrow> ys\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+
	+ interpret xs: vfsequence xs by (rule prems(2))
	+ interpret ys: vfsequence ys by (rule prems(4))
	+
	+ have "xs \<in>\<^sub>\<circ> vfsequences_on (F\<lparr>ArrDom\<rparr>)"
	+ unfolding cat_cs_simps by (intro vfsequences_onI prems(2,3))
	+ from vfsequence_map_ArrVal_app[OF this] have F_xs:
	+ "vfsequence_map F\<lparr>ArrVal\<rparr>\<lparr>xs\<rparr> = F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs"
	+ by simp
	+ from prems(3) have rxs: "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> A"
	+ by (intro vsubsetI) (auto dest: xs.vrange_atD)
	+ from xs.vfsequence_vdomain_in_omega have dxs: "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto intro!: Axiom_of_Infinity)
	+ note xs_is_arr = cat_Set_arr_of_vsv_is_arr
	+ [
	+ OF xs.vsv_axioms rxs,
	+ unfolded cat_Set_components(1),
	+ OF dxs F.arr_Par_ArrDom_in_Vset
	+ ]
	+
	+ have ys: "ys \<in>\<^sub>\<circ> vfsequences_on (F\<lparr>ArrDom\<rparr>)"
	+ unfolding cat_cs_simps by (intro vfsequences_onI prems(4,5))
	+ from vfsequence_map_ArrVal_app[OF this] have F_ys:
	+ "vfsequence_map F\<lparr>ArrVal\<rparr>\<lparr>ys\<rparr> = F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ys"
	+ by simp
	+ from prems(5) have rys: "\<R>\<^sub>\<circ> ys \<subseteq>\<^sub>\<circ> A"
	+ by (intro vsubsetI) (auto dest: ys.vrange_atD)
	+ from ys.vfsequence_vdomain_in_omega have dys: "\<D>\<^sub>\<circ> ys \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto intro!: Axiom_of_Infinity)
	+ note ys_is_arr = cat_Set_arr_of_vsv_is_arr
	+ [
	+ OF ys.vsv_axioms rys,
	+ unfolded cat_Set_components(1),
	+ OF dys F.arr_Par_ArrDom_in_Vset
	+ ]
	+
	+ note Fxs_Fys = prems(1)[unfolded F_xs F_ys]
	+
	+ from rxs have dom_rxs: "\<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> xs) = \<D>\<^sub>\<circ> xs"
	+ by (intro vdomain_vcomp_vsubset vsubsetI, unfold F.arr_Set_ArrVal_vdomain)
	+ auto
	+ moreover from rys have dom_rys: "\<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ys) = \<D>\<^sub>\<circ> ys"
	+ by (intro vdomain_vcomp_vsubset vsubsetI, unfold F.arr_Set_ArrVal_vdomain)
	+ auto
	+ ultimately have dxs_dys: "\<D>\<^sub>\<circ> xs = \<D>\<^sub>\<circ> ys"
	+ by (simp add: prems(1)[unfolded F_xs F_ys])
	+
	+ from FD(1) xs_is_arr have lhs_is_arr:
	+ "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv xs A : \<D>\<^sub>\<circ> xs \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_lhs:
	+ "\<D>\<^sub>\<circ> ((F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv xs A)\<lparr>ArrVal\<rparr>) = \<D>\<^sub>\<circ> xs"
	+ by (simp add: cat_cs_simps)
	+
	+ from FD(1) ys_is_arr have rhs_is_arr:
	+ "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv ys A : \<D>\<^sub>\<circ> xs \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_simp: dxs_dys cs_intro: cat_cs_intros)
	+ then have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv ys A)\<lparr>ArrVal\<rparr>) = \<D>\<^sub>\<circ> xs"
	+ by (simp add: cat_cs_simps)
	+
	+ have F_xs_F_ys:
	+ "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv xs A =
	+ F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv ys A"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ show
	+ "(F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv xs A)\<lparr>ArrVal\<rparr> =
	+ (F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv ys A)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix i assume prems: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs"
	+ from prems rxs have xsi: "xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+ by (auto dest: xs.vdomain_atD)
	+ from prems rys have ysi: "ys\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+ by (auto simp: dxs_dys dest: ys.vdomain_atD)
	+ from arg_cong[OF Fxs_Fys, where f=\<open>\<lambda>x. x\<lparr>i\<rparr>\<close>] prems FD(1) xsi ysi
	+ have "F\<lparr>ArrVal\<rparr>\<lparr>xs\<lparr>i\<rparr>\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>ys\<lparr>i\<rparr>\<rparr>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: V_cs_simps cat_cs_simps dxs_dys[symmetric]
	+ cs_intro: V_cs_intros cat_cs_intros
	+ )
	+ with prems FD(1) xs_is_arr ys_is_arr show
	+ "(F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv xs A)\<lparr>ArrVal\<rparr>\<lparr>i\<rparr> =
	+ (F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cat_Set_arr_of_vsv ys A)\<lparr>ArrVal\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_Set_cs_simps cat_cs_simps dxs_dys[symmetric]
	+ cs_intro: cat_cs_intros
	+ )
	+ qed (use lhs_is_arr rhs_is_arr in \<open>auto dest: cat_Set_is_arrD\<close>)
	+ qed
	+ (
	+ use lhs_is_arr rhs_is_arr in
	+ \<open>auto simp: cat_cs_simps dest: cat_Set_is_arrD(1)\<close>
	+ )+
	+ have "cat_Set_arr_of_vsv xs A = cat_Set_arr_of_vsv ys A"
	+ by
	+ (
	+ rule is_monic_arrD(2)[
	+ OF assms(1) xs_is_arr, unfolded dxs_dys, OF ys_is_arr, OF F_xs_F_ys
	+ ]
	+ )
	+ from arg_cong [OF this, where f=\<open>\<lambda>x. x\<lparr>ArrVal\<rparr>\<close>, unfolded cat_Set_cs_simps]
	+ show "xs = ys" .
	+
	+ qed (auto intro: cat_cs_intros)
	+
	+qed
	+
	+lemma (in \<Z>) vfsequence_map_is_epic_arr:
	+ assumes "F : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vfsequence_map F : vfsequences_on A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>cat_Set \<alpha>\<^esub> vfsequences_on B"
	+proof-
	+
	+ note cat_Set_is_epic_arrD[OF assms]
	+ note FD = this cat_Set_is_arrD[OF this(1)]
	+
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ interpret SF: arr_Set \<alpha> \<open>vfsequence_map F\<close>
	+ rewrites "vfsequence_map F\<lparr>ArrDom\<rparr> = vfsequences_on A"
	+ and "vfsequence_map F\<lparr>ArrCod\<rparr> = vfsequences_on B"
	+ by (intro cat_Set_is_arrD[OF vfsequence_map_is_arr[OF FD(1)]])+
	+
	+ show ?thesis
	+ proof
	+ (
	+ intro cat_Set_is_epic_arrI,
	+ rule vfsequence_map_is_arr[OF FD(1)],
	+ rule vsubset_antisym,
	+ rule SF.arr_Par_ArrVal_vrange,
	+ rule vsubsetI
	+ )
	+ fix xs assume prems: "xs \<in>\<^sub>\<circ> vfsequences_on B"
	+ note xsD = vfsequences_onD[OF prems]
	+ interpret vfsequence xs by (rule xsD(1))
	+ define ys where "ys = (\<lambda>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> xs. SOME x. x \<in>\<^sub>\<circ> A \<and> xs\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>)"
	+ have ys_vdomain: "\<D>\<^sub>\<circ> ys = \<D>\<^sub>\<circ> xs" unfolding ys_def by simp
	+ interpret ys: vfsequence ys
	+ by (rule vfsequenceI)
	+ (auto intro: vfsequence_vdomain_in_omega simp: ys_def)
	+ have ysi: "ys\<lparr>i\<rparr> = (SOME x. x \<in>\<^sub>\<circ> A \<and> xs\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>)"
	+ if "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" for i
	+ using that unfolding ys_def by simp
	+ have ysi: "ys\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+ and xsi_def: "xs\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>ys\<lparr>i\<rparr>\<rparr>"
	+ if "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" for i
	+ proof-
	+ have "xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)" by (rule xsD(2)[OF that, folded FD(2)])
	+ then obtain x where x: "x \<in>\<^sub>\<circ> A" and xsi_def: "xs\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ by (auto elim: F.ArrVal.vrange_atE simp: F.arr_Set_ArrVal_vdomain)
	+ show "ys\<lparr>i\<rparr> \<in>\<^sub>\<circ> A" and "xs\<lparr>i\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>ys\<lparr>i\<rparr>\<rparr>"
	+ unfolding ysi[OF that]
	+ by
	+ (
	+ all\<open>rule someI2_ex, intro exI conjI; (elim conjE)?\<close>,
	+ tactic\<open>distinct_subgoals_tac\<close>
	+ )
	+ (auto simp: x xsi_def)
	+ qed
	+ show "xs \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfsequence_map F\<lparr>ArrVal\<rparr>)"
	+ proof
	+ (
	+ intro vsv.vsv_vimageI2' cat_cs_intros,
	+ cs_concl_step vfsequence_map_ArrVal_app,
	+ unfold cat_cs_simps,
	+ tactic\<open>distinct_subgoals_tac\<close>
	+ )
	+ show "ys \<in>\<^sub>\<circ> vfsequences_on A"
	+ by (intro vfsequences_onI ys.vfsequence_axioms)
	+ (auto intro: ysi simp: ys_vdomain)
	+ show "xs = F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ys"
	+ proof(rule vsv_eqI)
	+ show "\<D>\<^sub>\<circ> xs = \<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ys)"
	+ unfolding ys_vdomain[symmetric]
	+ proof(intro vdomain_vcomp_vsubset[symmetric] vsubsetI)
	+ fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ys"
	+ then obtain i where i: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ys" and y_def: "y = ys\<lparr>i\<rparr>"
	+ by (auto dest: ys.vrange_atD)
	+ from i show "y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ unfolding y_def F.arr_Set_ArrVal_vdomain ys_vdomain by (rule ysi)
	+ qed
	+ show "xs\<lparr>i\<rparr> = (F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ys)\<lparr>i\<rparr>"
	+ if "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" for i
	+ using FD(1) that
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_cs_simps xsi_def ys_vdomain
	+ cs_intro: V_cs_intros ysi
	+ )
	+ qed (auto intro: vsv_vcomp)
	+ qed
	+ qed
	+
	+qed
	+
	+lemma vfsequence_map_is_iso_arr:
	+ assumes "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vfsequence_map F : vfsequences_on A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> vfsequences_on B"
	+proof-
	+ note cat_Set_is_iso_arrD[OF assms]
	+ note FD = this cat_Set_is_arrD[OF this(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (cs_concl cs_intro: cat_cs_intros)
	+ show ?thesis
	+ by
	+ (
	+ intro
	+ F.cat_Set_is_iso_arr_if_monic_and_epic
	+ F.vfsequence_map_is_monic_arr[
	+ OF Set.cat_is_iso_arr_is_monic_arr[OF assms]
	+ ]
	+ F.vfsequence_map_is_epic_arr[
	+ OF Set.cat_is_iso_arr_is_epic_arr[OF assms]
	+ ]
	+ )
	+qed
	+
	+
	+
	+subsection\<open>An injection from the range of an arrow in \<open>Set\<close> into its domain\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition vrange_iso :: "V \<Rightarrow> V"
	+ where "vrange_iso F =
	+ [
	+ (\<lambda>y\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>). (SOME x. x \<in>\<^sub>\<circ> F\<lparr>ArrDom\<rparr> \<and> y = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>)),
	+ \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>),
	+ F\<lparr>ArrDom\<rparr>
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma vrange_iso_components:
	+ shows "vrange_iso F\<lparr>ArrVal\<rparr> =
	+ (\<lambda>y\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>). (SOME x. x \<in>\<^sub>\<circ> F\<lparr>ArrDom\<rparr> \<and> y = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>))"
	+ and [cat_cs_simps]: "vrange_iso F\<lparr>ArrDom\<rparr> = \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ and [cat_cs_simps]: "vrange_iso F\<lparr>ArrCod\<rparr> = F\<lparr>ArrDom\<rparr>"
	+ unfolding vrange_iso_def arr_field_simps by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+mk_VLambda vrange_iso_components(1)
	+ \|vsv vrange_iso_ArrVal_vsv[cat_cs_intros]\|
	+ \|vdomain vrange_iso_ArrVal_vdomain[cat_cs_simps]\|
	+ \|app vrange_iso_ArrVal_app\|
	+
	+lemma vrange_iso_ArrVal_rules:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" and "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ shows "vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr> \<in>\<^sub>\<circ> A"
	+ and "y = F\<lparr>ArrVal\<rparr>\<lparr>vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr>\<rparr>"
	+proof-
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ from assms(2) have vri_Fy_def:
	+ "vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr> = (SOME x. x \<in>\<^sub>\<circ> F\<lparr>ArrDom\<rparr> \<and> y = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>)"
	+ by (cs_concl cs_simp: vrange_iso_ArrVal_app)
	+ from assms(2) F.arr_Set_ArrVal_vdomain obtain x
	+ where x: "x \<in>\<^sub>\<circ> A" and y_def: "y = F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ by (auto elim: F.ArrVal.vrange_atE)
	+ show "vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr> \<in>\<^sub>\<circ> A"
	+ and "y = F\<lparr>ArrVal\<rparr>\<lparr>vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr>\<rparr>"
	+ unfolding vri_Fy_def cat_cs_simps
	+ by (all\<open>rule someI2_ex; (intro exI conjI)?; (elim conjE)?\<close>)
	+ (simp_all add: x y_def)
	+qed
	+
	+
	+subsubsection\<open>
	+An injection from the range of a function into its domain is a monic in \<open>Set\<close>
	+\<close>
	+
	+lemma vrange_iso_is_arr:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vrange_iso F : \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+proof-
	+
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+
	+ show "vrange_iso F : \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+ proof(intro cat_Set_is_arrI arr_SetI, unfold cat_cs_simps)
	+ show "vfsequence (vrange_iso F)"
	+ unfolding vrange_iso_def by (simp_all add: nat_omega_simps)
	+ show "vsv (vrange_iso F\<lparr>ArrVal\<rparr>)"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then interpret vsv \<open>vrange_iso F\<lparr>ArrVal\<rparr>\<close>
	+ rewrites "\<D>\<^sub>\<circ> (vrange_iso F\<lparr>ArrVal\<rparr>) = \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ unfolding cat_cs_simps by simp_all
	+ show "vcard (vrange_iso F) = 3\<^sub>\<nat>"
	+ unfolding vrange_iso_def by (simp_all add: nat_omega_simps)
	+ show "\<R>\<^sub>\<circ> (vrange_iso F\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A"
	+ proof(intro vsubsetI)
	+ fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vrange_iso F\<lparr>ArrVal\<rparr>)"
	+ then obtain y where y: "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ and x_def: "x = vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr>"
	+ by (auto dest: vrange_atD)
	+ show "x \<in>\<^sub>\<circ> A"
	+ unfolding x_def
	+ by (rule vrange_iso_ArrVal_rules(1)[OF assms y, unfolded cat_cs_simps])
	+ qed
	+ qed
	+ (
	+ auto
	+ simp: F.arr_Set_ArrDom_in_Vset
	+ intro: vrange_in_VsetI F.arr_Rel_ArrVal_in_Vset
	+ )
	+
	+qed
	+
	+lemma vrange_iso_is_arr':
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "B' = \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "vrange_iso F : B' \<mapsto>\<^bsub>\<CC>'\<^esub> A"
	+ using assms(1) unfolding assms(2,3) by (rule vrange_iso_is_arr)
	+
	+lemma vrange_iso_is_monic_arr:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ shows "vrange_iso F : \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>cat_Set \<alpha>\<^esub> A"
	+proof-
	+ note FD = cat_Set_is_arrD[OF assms(1)]
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = A" and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = B"
	+ by (intro FD)+
	+ show ?thesis
	+ proof
	+ (
	+ intro cat_Set_is_monic_arrI vrange_iso_is_arr,
	+ rule assms,
	+ rule vsv.vsv_valeq_v11I[OF vrange_iso_ArrVal_vsv],
	+ unfold cat_cs_simps
	+ )
	+ fix x y assume prems:
	+ "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ "vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = vrange_iso F\<lparr>ArrVal\<rparr>\<lparr>y\<rparr>"
	+ show "x = y"
	+ by
	+ (
	+ rule vrange_iso_ArrVal_rules(2)
	+ [
	+ OF assms prems(1),
	+ unfolded prems(3),
	+ folded vrange_iso_ArrVal_rules(2)[OF assms prems(2)]
	+ ]
	+ )
	+ qed simp
	+qed
	+
	+lemma vrange_iso_is_monic_arr':
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "B' = \<R>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>)"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "vrange_iso F : B' \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>'\<^esub> A"
	+ using assms(1) unfolding assms(2,3) by (rule vrange_iso_is_monic_arr)
	+
	+
	+
	subsection\<open>Auxiliary\<close>


	text\<open>
	This subsection is reserved for insignificant helper lemmas
	and rules that are used in applied formalization elsewhere.
	\<close>

	lemma (in \<Z>) cat_Rel_CId_is_cat_Set_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	proof-
	from assms show ?thesis
	unfolding cat_Rel_components cat_Set_components(6)[symmetric]
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1) cs_intro: cat_cs_intros
	)
	qed

	lemma (in \<Z>) cat_Rel_CId_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B' = A"
	and "C' = A"
	and "\<CC>' = cat_Set \<alpha>"
	shows "cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr> : B' \<mapsto>\<^bsub>\<CC>'\<^esub> C'"
	using assms(1) unfolding assms(2-4) by (rule cat_Rel_CId_is_cat_Set_arr)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
	@@ -1,586 +1,622 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Simple categories\<close>
	theory CZH_ECAT_Simple
	imports
	CZH_Foundations.CZH_SMC_Simple
	CZH_ECAT_NTCF
	CZH_ECAT_Small_Functor
	begin



	subsection\<open>Background\<close>


	text\<open>
	The section presents a variety of simple categories,
	(such as the empty category \<open>0\<close> and the singleton category \<open>1\<close>)
	and functors between them (see \cite{mac_lane_categories_2010}
	for further information).
	\<close>



	subsection\<open>Empty category \<open>0\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-2 in \cite{mac_lane_categories_2010}.\<close>

	definition cat_0 :: "V"
	where "cat_0 = [0, 0, 0, 0, 0, 0]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_0_components:
	shows "cat_0\<lparr>Obj\<rparr> = 0"
	and "cat_0\<lparr>Arr\<rparr> = 0"
	and "cat_0\<lparr>Dom\<rparr> = 0"
	and "cat_0\<lparr>Cod\<rparr> = 0"
	and "cat_0\<lparr>Comp\<rparr> = 0"
	and "cat_0\<lparr>CId\<rparr> = 0"
	unfolding cat_0_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cat_smc_cat_0: "cat_smc cat_0 = smc_0"
	unfolding cat_smc_def cat_0_def smc_0_def dg_field_simps
	by (simp add: nat_omega_simps)

	lemmas_with (in \<Z>) [folded cat_smc_cat_0, unfolded slicing_simps]:
	cat_0_is_arr_iff = smc_0_is_arr_iff


	subsubsection\<open>\<open>0\<close> is a category\<close>

	lemma (in \<Z>) category_cat_0[cat_cs_intros]: "category \<alpha> cat_0"
	proof(intro categoryI)
	show "vfsequence cat_0" "vcard cat_0 = 6\<^sub>\<nat>"
	by (simp_all add: cat_0_def nat_omega_simps)
	qed
	(
	auto simp:
	\<Z>_axioms
	cat_0_components
	cat_0_is_arr_iff
	cat_smc_cat_0
	\<Z>.semicategory_smc_0
	)

	lemmas [cat_cs_intros] = \<Z>.category_cat_0


	subsubsection\<open>Opposite of the category \<open>0\<close>\<close>

	lemma op_cat_cat_0[cat_op_simps]: "op_cat (cat_0) = cat_0"
	proof(rule cat_smc_eqI)
	define \<beta> where "\<beta> = \<omega> + \<omega>"
	interpret \<beta>: \<Z> \<beta> unfolding \<beta>_def by (rule \<Z>_\<omega>\<omega>)
	show "category \<beta> (op_cat cat_0)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	show "category \<beta> cat_0" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	qed
	(
	simp_all add:
	cat_0_components op_cat_components cat_smc_cat_0
	slicing_commute[symmetric] smc_op_simps
	)



	subsection\<open>Empty functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_0 :: "V \<Rightarrow> V"
	where "cf_0 \<AA> = [0, 0, cat_0, \<AA>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_0_components:
	shows "cf_0 \<AA>\<lparr>ObjMap\<rparr> = 0"
	and "cf_0 \<AA>\<lparr>ArrMap\<rparr> = 0"
	and "cf_0 \<AA>\<lparr>HomDom\<rparr> = cat_0"
	and "cf_0 \<AA>\<lparr>HomCod\<rparr> = \<AA>"
	unfolding cf_0_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma cf_smcf_cf_0: "cf_smcf (cf_0 \<AA>) = smcf_0 (cat_smc \<AA>)"
	unfolding
	dg_field_simps dghm_field_simps
	cf_smcf_def cf_0_def smc_0_def cat_0_def smcf_0_def cat_smc_def
	by (simp add: nat_omega_simps)


	text\<open>Opposite empty category homomorphism.\<close>

	lemma op_cf_cf_0: "op_cf (cf_0 \<CC>) = cf_0 (op_cat \<CC>)"
	unfolding
	cf_0_def op_cat_def op_cf_def cat_0_def dghm_field_simps dg_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_0_ObjMap_vsv[cat_cs_intros]: "vsv (cf_0 \<CC>\<lparr>ObjMap\<rparr>)"
	unfolding cf_0_components by simp


	subsubsection\<open>Arrow map\<close>

	lemma cf_0_ArrMap_vsv[cat_cs_intros]: "vsv (cf_0 \<CC>\<lparr>ArrMap\<rparr>)"
	unfolding cf_0_components by simp


	subsubsection\<open>Empty functor is a faithful functor\<close>

	-lemma (in \<Z>) cf_0_is_ft_functor:
	+lemma cf_0_is_ft_functor:
	assumes "category \<alpha> \<AA>"
	shows "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule is_ft_functorI)
	+ interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
	show "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule is_functorI, unfold cat_smc_cat_0 cf_smcf_cf_0)
	show "vfsequence (cf_0 \<AA>)" unfolding cf_0_def by simp
	show "vcard (cf_0 \<AA>) = 4\<^sub>\<nat>"
	unfolding cf_0_def by (simp add: nat_omega_simps)
	from \<Z>.smcf_0_is_ft_semifunctor assms show
	"smcf_0 (cat_smc \<AA>) : smc_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
	by auto
	- qed (auto simp: assms category_cat_0 cat_0_components cf_0_components)
	+ qed (auto simp: assms \<AA>.category_cat_0 cat_0_components cf_0_components)
	show "cf_smcf (cf_0 \<AA>) : cat_smc cat_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
	by
	(
	auto simp:
	assms
	- \<Z>_axioms
	- \<Z>.smcf_0_is_ft_semifunctor
	+ \<AA>.\<Z>_axioms
	+ \<AA>.smcf_0_is_ft_semifunctor
	category.cat_semicategory
	cf_smcf_cf_0
	cat_smc_cat_0
	)
	qed

	-lemma (in \<Z>) cf_0_is_ft_functor'[cf_cs_intros]:
	+lemma cf_0_is_ft_functor'[cf_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "\<BB>' = \<AA>"
	and "\<AA>' = cat_0"
	shows "cf_0 \<AA> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cf_0_is_ft_functor)

	-lemmas [cf_cs_intros] = \<Z>.cf_0_is_ft_functor'
	-
	-lemma (in \<Z>) cf_0_is_functor:
	+lemma cf_0_is_functor:
	assumes "category \<alpha> \<AA>"
	shows "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using cf_0_is_ft_functor[OF assms] by auto

	-lemma (in \<Z>) cf_0_is_functor'[cat_cs_intros]:
	+lemma cf_0_is_functor'[cat_cs_intros]:
	assumes "category \<alpha> \<AA>"
	and "\<BB>' = \<AA>"
	and "\<AA>' = cat_0"
	shows "cf_0 \<AA> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cf_0_is_functor)

	-lemmas [cat_cs_intros] = \<Z>.cf_0_is_functor'
	-

	subsubsection\<open>Further properties\<close>

	lemma is_functor_is_cf_0_if_cat_0:
	assumes "\<FF> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<FF> = cf_0 \<CC>"
	proof(rule cf_smcf_eqI)
	interpret \<FF>: is_functor \<alpha> cat_0 \<CC> \<FF> by (rule assms(1))
	show "\<FF> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(1))
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = 0" "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = 0"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_0_components)+
	show "cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "cf_smcf \<FF> = cf_smcf (cf_0 \<CC>)"
	unfolding cf_smcf_cf_0
	by
	(
	rule is_semifunctor_is_smcf_0_if_smc_0,
	rule \<FF>.cf_is_semifunctor[unfolded slicing_simps cat_smc_cat_0]
	)
	qed simp_all

	+lemma (in is_functor) cf_comp_cf_cf_0[cat_cs_simps]: "\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA> = cf_0 \<BB>"
	+proof(rule cf_eqI)
	+ show "\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: cat_cs_intros)
	+ then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ObjMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
	+ and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ArrMap\<rparr>) = cat_0\<lparr>Arr\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)+
	+ show "cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ then have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_0 \<BB>\<lparr>ObjMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
	+ and ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_0 \<BB>\<lparr>ArrMap\<rparr>) = cat_0\<lparr>Arr\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)+
	+ show "(\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ObjMap\<rparr> = cf_0 \<BB>\<lparr>ObjMap\<rparr>"
	+ by
	+ (
	+ rule vsv_eqI,
	+ unfold ObjMap_dom_lhs ObjMap_dom_rhs ArrMap_dom_lhs ArrMap_dom_rhs
	+ )
	+ (auto simp: cat_0_components intro: cat_cs_intros)
	+ show "(\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ArrMap\<rparr> = cf_0 \<BB>\<lparr>ArrMap\<rparr>"
	+ by
	+ (
	+ rule vsv_eqI,
	+ unfold ObjMap_dom_lhs ObjMap_dom_rhs ArrMap_dom_lhs ArrMap_dom_rhs
	+ )
	+ (auto simp: cat_0_components intro: cat_cs_intros)
	+qed simp_all
	+
	+lemmas [cat_cs_simps] = is_functor.cf_comp_cf_cf_0
	+


	subsection\<open>Empty natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter X-1 in \cite{mac_lane_categories_2010}.\<close>

	definition ntcf_0 :: "V \<Rightarrow> V"
	where "ntcf_0 \<CC> = [0, cf_0 \<CC>, cf_0 \<CC>, cat_0, \<CC>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_0_components:
	shows "ntcf_0 \<CC>\<lparr>NTMap\<rparr> = 0"
	and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDom\<rparr> = cf_0 \<CC>"
	and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTCod\<rparr> = cf_0 \<CC>"
	and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDGDom\<rparr> = cat_0"
	and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding ntcf_0_def nt_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma ntcf_ntsmcf_ntcf_0: "ntcf_ntsmcf (ntcf_0 \<AA>) = ntsmcf_0 (cat_smc \<AA>)"
	unfolding
	ntcf_ntsmcf_def ntcf_0_def ntsmcf_0_def cat_smc_def
	cf_smcf_def smcf_0_def cf_0_def cat_0_def smc_0_def
	dg_field_simps dghm_field_simps nt_field_simps
	by (simp add: nat_omega_simps)


	text\<open>Duality.\<close>

	lemma op_ntcf_ntcf_0: "op_ntcf (ntcf_0 \<CC>) = ntcf_0 (op_cat \<CC>)"
	by
	(
	simp_all add:
	op_ntcf_def ntcf_0_def op_cat_def op_cf_cf_0 cat_0_def
	nt_field_simps dg_field_simps nat_omega_simps
	)


	subsubsection\<open>Natural transformation map\<close>

	lemma ntcf_0_NTMap_vsv[cat_cs_intros]: "vsv (ntcf_0 \<CC>\<lparr>NTMap\<rparr>)"
	unfolding ntcf_0_components by simp

	lemma ntcf_0_NTMap_vdomain[cat_cs_simps]: "\<D>\<^sub>\<circ> (ntcf_0 \<CC>\<lparr>NTMap\<rparr>) = 0"
	unfolding ntcf_0_components by simp

	lemma ntcf_0_NTMap_vrange[cat_cs_simps]: "\<R>\<^sub>\<circ> (ntcf_0 \<CC>\<lparr>NTMap\<rparr>) = 0"
	unfolding ntcf_0_components by simp


	subsubsection\<open>Empty natural transformation is a natural transformation\<close>

	lemma (in category) cat_ntcf_0_is_ntcfI:
	"ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_ntcfI)
	show "vfsequence (ntcf_0 \<CC>)" unfolding ntcf_0_def by simp
	show "vcard (ntcf_0 \<CC>) = 5\<^sub>\<nat>"
	unfolding ntcf_0_def by (simp add: nat_omega_simps)
	show "ntcf_ntsmcf (ntcf_0 \<CC>) :
	cf_smcf (cf_0 \<CC>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (cf_0 \<CC>) :
	cat_smc cat_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding ntcf_ntsmcf_ntcf_0 cf_smcf_cf_0 cat_smc_cat_0
	by (cs_concl cs_shallow cs_intro: smc_cs_intros slicing_intros)
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	lemma (in category) cat_ntcf_0_is_ntcfI'[cat_cs_intros]:
	assumes "\<FF>' = cf_0 \<CC>"
	and "\<GG>' = cf_0 \<CC>"
	and "\<AA>' = cat_0"
	and "\<BB>' = \<CC>"
	and "\<FF>' = \<FF>"
	and "\<GG>' = \<GG>"
	shows "ntcf_0 \<CC> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule cat_ntcf_0_is_ntcfI)

	lemmas [cat_cs_intros] = category.cat_ntcf_0_is_ntcfI'

	lemma is_ntcf_is_ntcf_0_if_cat_0:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<NN> = ntcf_0 \<CC>" and "\<FF> = cf_0 \<CC>" and "\<GG> = cf_0 \<CC>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	note is_ntsmcf_is_ntsmcf_0_if_smc_0 = is_ntsmcf_is_ntsmcf_0_if_smc_0
	[
	OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
	folded smcf_dghm_smcf_0 ntsmcf_tdghm_ntsmcf_0
	]
	show \<FF>_def: "\<FF> = cf_0 \<CC>" and \<GG>_def: "\<GG> = cf_0 \<CC>"
	by (all\<open>intro is_functor_is_cf_0_if_cat_0\<close>)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)+
	show "\<NN> = ntcf_0 \<CC>"
	proof(rule ntcf_ntsmcf_eqI)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(1))
	show "ntcf_0 \<CC> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: \<FF>_def \<GG>_def cs_intro: cat_cs_intros)
	qed
	(
	simp_all add:
	\<FF>_def \<GG>_def is_ntsmcf_is_ntsmcf_0_if_smc_0 ntcf_ntsmcf_ntcf_0
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma ntcf_vcomp_ntcf_ntcf_0[cat_cs_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<CC> = ntcf_0 \<CC>"
	proof(rule ntcf_ntsmcf_eqI)
	interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	show "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	unfolding is_ntcf_is_ntcf_0_if_cat_0[OF assms]
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_ntsmcf (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_0 \<CC>) = ntcf_ntsmcf (ntcf_0 \<CC>)"
	unfolding
	slicing_commute[symmetric]
	ntsmcf_vcomp_ntsmcf_ntsmcf_0
	[
	OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
	folded ntcf_ntsmcf_ntcf_0
	]
	..
	qed simp_all

	lemma ntcf_vcomp_ntcf_0_ntcf[cat_cs_simps]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_0 \<CC>"
	proof(rule ntcf_ntsmcf_eqI)
	interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	show "ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	unfolding is_ntcf_is_ntcf_0_if_cat_0[OF assms]
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "ntcf_ntsmcf (ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_ntsmcf (ntcf_0 \<CC>)"
	unfolding
	slicing_commute[symmetric]
	ntsmcf_vcomp_ntsmcf_0_ntsmcf
	[
	OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
	folded ntcf_ntsmcf_ntcf_0
	]
	..
	+ qed simp_all
	+
	+lemma (in is_functor) cf_ntcf_comp_cf_ntcf_0[cat_cs_simps]:
	+ "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA> = ntcf_0 \<BB>"
	+proof(rule ntcf_eqI)
	+ show "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA> : cf_0 \<BB> \<mapsto>\<^sub>C\<^sub>F cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA>)\<lparr>NTMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "ntcf_0 \<BB> : cf_0 \<BB> \<mapsto>\<^sub>C\<^sub>F cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_0 \<BB>\<lparr>NTMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "(\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA>)\<lparr>NTMap\<rparr> = ntcf_0 \<BB>\<lparr>NTMap\<rparr>"
	+ by (rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ (auto simp: cat_0_components intro!: cat_cs_intros)+
	qed simp_all

	+lemmas [cat_cs_simps] = is_functor.cf_ntcf_comp_cf_ntcf_0
	+


	subsection\<open>\<open>1\<close>: category with one object and one arrow\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-2 in \cite{mac_lane_categories_2010}.\<close>

	definition cat_1 :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cat_1 \<aa> \<ff> =
	[
	set {\<aa>},
	set {\<ff>},
	set {\<langle>\<ff>, \<aa>\<rangle>},
	set {\<langle>\<ff>, \<aa>\<rangle>},
	set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>},
	set {\<langle>\<aa>, \<ff>\<rangle>}
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cat_1_components:
	shows "cat_1 \<aa> \<ff>\<lparr>Obj\<rparr> = set {\<aa>}"
	and "cat_1 \<aa> \<ff>\<lparr>Arr\<rparr> = set {\<ff>}"
	and "cat_1 \<aa> \<ff>\<lparr>Dom\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
	and "cat_1 \<aa> \<ff>\<lparr>Cod\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
	and "cat_1 \<aa> \<ff>\<lparr>Comp\<rparr> = set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>}"
	and "cat_1 \<aa> \<ff>\<lparr>CId\<rparr> = set {\<langle>\<aa>, \<ff>\<rangle>}"
	unfolding cat_1_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smc_cat_1: "cat_smc (cat_1 \<aa> \<ff>) = smc_1 \<aa> \<ff>"
	unfolding cat_smc_def cat_1_def smc_1_def dg_field_simps
	by (simp add: nat_omega_simps)

	-lemmas_with (in \<Z>) [folded smc_cat_1, unfolded slicing_simps]:
	+lemmas_with [folded smc_cat_1, unfolded slicing_simps]:
	cat_1_is_arrI = smc_1_is_arrI
	and cat_1_is_arrD = smc_1_is_arrD
	and cat_1_is_arrE = smc_1_is_arrE
	and cat_1_is_arr_iff = smc_1_is_arr_iff
	and cat_1_Comp_app[cat_cs_simps] = smc_1_Comp_app


	subsubsection\<open>Object\<close>

	lemma cat_1_ObjI[cat_cs_intros]:
	assumes "a = \<aa>"
	shows "a \<in>\<^sub>\<circ> cat_1 \<aa> \<ff> \<lparr>Obj\<rparr>"
	unfolding cat_1_components(1) assms by simp


	subsubsection\<open>Identity\<close>

	lemma cat_1_CId_app: "cat_1 \<aa> \<ff>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr> = \<ff>"
	unfolding cat_1_components by simp


	-subsubsection\<open>Arrow with a domain and a codomain\<close>
	-
	-lemma cat_1_is_arrI:
	- assumes "f = \<ff>" and "a = \<aa>" and "b = \<aa>"
	- shows "f : a \<mapsto>\<^bsub>cat_1 \<aa> \<ff>\<^esub> b"
	- by (rule is_arrI, unfold assms cat_1_components) auto
	-
	-
	subsubsection\<open>\<open>1\<close> is a category\<close>

	lemma (in \<Z>) category_cat_1:
	assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "category \<alpha> (cat_1 \<aa> \<ff>)"
	proof(intro categoryI, unfold smc_cat_1)
	show "vfsequence (cat_1 \<aa> \<ff>)"
	unfolding cat_1_def by (simp add: nat_omega_simps)
	show "vcard (cat_1 \<aa> \<ff>) = 6\<^sub>\<nat>"
	unfolding cat_1_def by (simp add: nat_omega_simps)
	qed (auto simp: assms semicategory_smc_1 cat_1_is_arr_iff cat_1_components)

	lemmas [cat_cs_intros] = \<Z>.category_cat_1

	lemma (in \<Z>) finite_category_cat_1:
	assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "finite_category \<alpha> (cat_1 \<aa> \<ff>)"
	by (intro finite_categoryI')
	(auto simp: cat_1_components intro: category_cat_1[OF assms])

	lemmas [cat_small_cs_intros] = \<Z>.finite_category_cat_1


	subsubsection\<open>Opposite of the category \<open>1\<close>\<close>

	lemma (in \<Z>) cat_1_op[cat_op_simps]:
	assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "op_cat (cat_1 \<aa> \<ff>) = cat_1 \<aa> \<ff>"
	proof(rule cat_eqI, unfold cat_op_simps)
	from assms show "category \<alpha> (op_cat (cat_1 \<aa> \<ff>))"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	from assms show "category \<alpha> (cat_1 \<aa> \<ff>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "op_cat (cat_1 \<aa> \<ff>)\<lparr>Comp\<rparr> = cat_1 \<aa> \<ff>\<lparr>Comp\<rparr>"
	unfolding cat_1_components op_cat_components fflip_vsingleton ..
	qed (simp_all add: cat_1_components)

	lemma (in \<Z>) cat_1_op_0[cat_op_simps]: "op_cat (cat_1 0 0) = cat_1 0 0"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: V_cs_intros cat_cs_intros
	)


	subsubsection\<open>Further properties\<close>

	lemma cf_const_if_HomCod_is_cat_1:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
	shows "\<KK> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>"
	proof(rule cf_eqI)
	interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(1))
	show "cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
	by (cs_concl cs_intro: cat_cs_intros)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
	have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (simp add: cat_cs_simps)
	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>" by (simp add: cat_cs_simps)
	have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by (simp add: cat_cs_simps)
	show "\<KK>\<lparr>ObjMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
	by (auto intro: \<KK>.cf_ObjMap_app_in_HomCod_Obj)
	then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<aa>" by (auto simp: cat_1_components)
	with prems show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (auto simp: cat_cs_simps)
	qed (auto intro: cat_cs_intros)
	show "\<KK>\<lparr>ArrMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Arr\<rparr>"
	by (auto intro: \<KK>.cf_ArrMap_app_in_HomCod_Arr)
	then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<ff>" by (auto simp: cat_1_components)
	with prems show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	by (auto simp: cat_1_CId_app cat_cs_simps)
	qed (auto intro: cat_cs_intros)
	qed (simp_all add: assms)

	lemma cf_const_if_HomDom_is_cat_1:
	assumes "\<KK> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<KK> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
	proof-

	interpret \<KK>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<KK> by (rule assms(1))

	from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<KK>.HomDom.cat_in_Obj_in_Vset)
	from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<KK>.HomDom.cat_in_Arr_in_Vset)

	from \<aa> \<ff> interpret cf_1:
	is_tm_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<open>cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<close>
	by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule cf_eqI)
	show "cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = set {\<aa>}"
	by (simp add: cat_cs_simps cat_1_components)
	have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>) = set {\<aa>}"
	by (simp add: cat_cs_simps cat_1_components)
	show "\<KK>\<lparr>ObjMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> set {\<aa>}"
	then have a_def: "a = \<aa>" by simp
	show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_1_components(1) cat_cs_simps a_def
	cs_intro: V_cs_intros
	)
	qed auto

	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = set {\<ff>}"
	by (simp add: cat_cs_simps cat_1_components)
	have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>) = set {\<ff>}"
	by (simp add: cat_cs_simps cat_1_components)

	show "\<KK>\<lparr>ArrMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume "f \<in>\<^sub>\<circ> set {\<ff>}"
	then have f_def: "f = \<ff>" by simp
	show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	unfolding f_def
	by (subst cat_1_CId_app[symmetric, of \<ff> \<aa>])
	(
	cs_concl cs_shallow
	cs_simp: cat_1_components(1,2) cat_cs_simps
	cs_intro: V_cs_intros cat_cs_intros
	)
	qed auto

	qed (simp_all add: assms)

	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_Cone.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_Cone.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_Cone.thy
	@@ -0,0 +1,638 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Smallness for cones and cocones\<close>
	+theory CZH_ECAT_Small_Cone
	+ imports
	+ CZH_ECAT_Cone
	+ CZH_ECAT_Small_NTCF
	+begin
	+
	+
	+
	+subsection\<open>Cone with tiny maps and cocone with tiny maps\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+locale is_tm_cat_cone =
	+ is_ntcf \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close> \<FF> \<NN> + NTCod: is_tm_functor \<alpha> \<JJ> \<CC> \<FF>
	+ for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	+ assumes tm_cat_cone_obj[cat_cs_intros, cat_small_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+
	+syntax "_is_tm_cat_cone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_cone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	+
	+locale is_tm_cat_cocone =
	+ is_ntcf \<alpha> \<JJ> \<CC> \<FF> \<open>cf_const \<JJ> \<CC> c\<close> \<NN> + NTDom: is_tm_functor \<alpha> \<JJ> \<CC> \<FF>
	+ for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	+ assumes tm_cat_cocone_obj[cat_cs_intros, cat_small_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+
	+syntax "_is_tm_cat_cocone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_cocone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_tm_cat_cone) is_tm_cat_cone_axioms'[
	+ cat_cs_intros, cat_small_cs_intros
	+ ]:
	+ assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "\<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_cone_axioms)
	+
	+mk_ide rf is_tm_cat_cone_def[unfolded is_tm_cat_cone_axioms_def]
	+ \|intro is_tm_cat_coneI\|
	+ \|dest is_tm_cat_coneD[dest!]\|
	+ \|elim is_tm_cat_coneE[elim!]\|
	+
	+lemma (in is_tm_cat_cocone) is_tm_cat_cocone_axioms'[
	+ cat_cs_intros, cat_small_cs_intros
	+ ]:
	+ assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "\<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_cocone_axioms)
	+
	+mk_ide rf is_tm_cat_cocone_def[unfolded is_tm_cat_cocone_axioms_def]
	+ \|intro is_tm_cat_coconeI\|
	+ \|dest is_tm_cat_coconeD[dest!]\|
	+ \|elim is_tm_cat_coconeE[elim!]\|
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_tm_cat_cone) is_tm_cat_cocone_op:
	+ "op_ntcf \<NN> : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_tm_cat_coconeI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )+
	+
	+lemma (in is_tm_cat_cone) is_tm_cat_cocone_op'[cat_op_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	+ shows "op_ntcf \<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_cocone_op)
	+
	+lemmas [cat_op_intros] = is_tm_cat_cone.is_tm_cat_cocone_op'
	+
	+lemma (in is_tm_cat_cocone) is_tm_cat_cone_op:
	+ "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_tm_cat_coneI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_tm_cat_cocone) is_tm_cat_cone_op'[cat_op_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	+ shows "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_cone_op)
	+
	+lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_tm_cat_cone) tm_cat_cone_is_tm_ntcf'[
	+ cat_cs_intros, cat_small_cs_intros
	+ ]:
	+ assumes "c' = cf_const \<JJ> \<CC> c"
	+ shows "\<NN> : c' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding assms
	+proof(intro is_tm_ntcfI')
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule NTCod.is_tm_functor_axioms)
	+ show "cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
	+qed (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros assms)+
	+
	+lemmas [cat_small_cs_intros] = is_tm_cat_cone.tm_cat_cone_is_tm_ntcf'
	+
	+sublocale is_tm_cat_cone \<subseteq> is_tm_ntcf \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close> \<FF> \<NN>
	+ by (intro tm_cat_cone_is_tm_ntcf') simp
	+
	+lemma (in is_tm_cat_cocone) tm_cat_cocone_is_tm_ntcf'[
	+ cat_cs_intros, cat_small_cs_intros
	+ ]:
	+ assumes "c' = cf_const \<JJ> \<CC> c"
	+ shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding assms
	+proof(intro is_tm_ntcfI')
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule NTDom.is_tm_functor_axioms)
	+ show "cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
	+qed (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros assms)+
	+
	+lemmas [cat_small_cs_intros, cat_cs_intros] =
	+ is_tm_cat_cocone.tm_cat_cocone_is_tm_ntcf'
	+
	+sublocale is_tm_cat_cocone \<subseteq> is_tm_ntcf \<alpha> \<JJ> \<CC> \<FF> \<open>cf_const \<JJ> \<CC> c\<close> \<NN>
	+ by (intro tm_cat_cocone_is_tm_ntcf') simp
	+
	+sublocale is_tm_cat_cone \<subseteq> is_cat_cone
	+ by (intro is_cat_coneI, rule is_ntcf_axioms, rule tm_cat_cone_obj)
	+
	+lemmas (in is_tm_cat_cone) tm_cat_cone_is_cat_cone = is_cat_cone_axioms
	+lemmas [cat_small_cs_intros] = is_tm_cat_cone.tm_cat_cone_is_cat_cone
	+
	+sublocale is_tm_cat_cocone \<subseteq> is_cat_cocone
	+ by (intro is_cat_coconeI, rule is_ntcf_axioms, rule tm_cat_cocone_obj)
	+
	+lemmas (in is_tm_cat_cocone) tm_cat_cocone_is_cat_cocone = is_cat_cocone_axioms
	+lemmas [cat_small_cs_intros] = is_tm_cat_cocone.tm_cat_cocone_is_cat_cocone
	+
	+
	+subsubsection\<open>
	+Vertical composition of a natural transformation with tiny maps
	+and a cone with tiny maps
	+\<close>
	+
	+lemma ntcf_vcomp_is_tm_cat_cone[cat_cs_intros]:
	+ assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<NN> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ intro is_tm_cat_coneI ntcf_vcomp_is_ntcf;
	+ (rule is_tm_ntcfD'[OF assms(1)])?;
	+ (intro is_tm_cat_coneD[OF assms(2)])?
	+ )
	+
	+
	+subsubsection\<open>
	+Composition of a functor and a cone with tiny maps,
	+composition of a functor and a cocone with tiny maps
	+\<close>
	+
	+lemma cf_ntcf_comp_tm_cf_tm_cat_cone:
	+ assumes "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<NN>: is_tm_cat_cone \<alpha> c \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+ interpret \<GG>\<FF>: is_tm_functor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> by (rule assms(3))
	+ show ?thesis
	+ by (intro is_tm_cat_coneI)
	+ (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros is_cat_coneD)+
	+qed
	+
	+lemma cf_ntcf_comp_tm_cf_tm_cat_cone'[cat_small_cs_intros]:
	+ assumes "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and "\<GG>\<FF> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG>\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ using assms(1,2,3)
	+ unfolding assms(4,5)
	+ by (rule cf_ntcf_comp_tm_cf_tm_cat_cone)
	+
	+lemma cf_ntcf_comp_tm_cf_tm_cat_cocone:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<NN>: is_tm_cat_cocone \<alpha> c \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	+ interpret \<GG>\<FF>: is_tm_functor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> by (rule assms(3))
	+ show ?thesis
	+ by
	+ (
	+ rule is_tm_cat_cone.is_tm_cat_cocone_op
	+ [
	+ OF cf_ntcf_comp_tm_cf_tm_cat_cone[
	+ OF \<NN>.is_tm_cat_cone_op \<GG>.is_functor_op, unfolded cat_op_simps
	+ ],
	+ OF \<GG>\<FF>.is_tm_functor_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+lemma cf_ntcf_comp_tm_cf_tm_cat_cocone'[cat_small_cs_intros]:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and "\<GG>\<FF> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<GG>\<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ using assms(1-3)
	+ unfolding assms(4,5)
	+ by (rule cf_ntcf_comp_tm_cf_tm_cat_cocone)
	+
	+
	+subsubsection\<open>
	+Cones and cocones with tiny maps and constant natural transformations
	+\<close>
	+
	+lemma ntcf_vcomp_ntcf_const_is_tm_cat_cone:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<BB> f : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof-
	+ interpret \<NN>: is_tm_cat_cone \<alpha> b \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ from assms(2) show ?thesis
	+ by (intro is_tm_cat_coneI)
	+ (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
	+qed
	+
	+lemma ntcf_vcomp_ntcf_const_is_tm_cat_cone'[cat_small_cs_intros]:
	+ assumes "\<NN> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> = ntcf_const \<AA> \<BB> f"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ using assms(1,3)
	+ unfolding assms(2)
	+ by (rule ntcf_vcomp_ntcf_const_is_tm_cat_cone)
	+
	+lemma ntcf_vcomp_ntcf_const_is_tm_cat_cocone:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "ntcf_const \<AA> \<BB> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof-
	+ interpret \<NN>: is_tm_cat_cocone \<alpha> a \<AA> \<BB> \<FF> \<NN> by (rule assms(1))
	+ from is_tm_cat_cone.is_tm_cat_cocone_op
	+ [
	+ OF ntcf_vcomp_ntcf_const_is_tm_cat_cone[
	+ OF \<NN>.is_tm_cat_cone_op, unfolded cat_op_simps, OF assms(2)
	+ ],
	+ unfolded cat_op_simps,
	+ folded op_ntcf_ntcf_const
	+ ]
	+ assms(2)
	+ show ?thesis
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
	+qed
	+
	+lemma ntcf_vcomp_ntcf_const_is_tm_cat_cocone'[cat_cs_intros]:
	+ assumes "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<MM> = ntcf_const \<AA> \<BB> f"
	+ and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ using assms(1,3)
	+ unfolding assms(2)
	+ by (rule ntcf_vcomp_ntcf_const_is_tm_cat_cocone)
	+
	+
	+
	+subsection\<open>Small cone and small cocone functors\<close>(TODO: duality automation)
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition tm_cf_Cone :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "tm_cf_Cone \<alpha> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F
	+ op_cf (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
	+
	+definition tm_cf_Cocone :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "tm_cf_Cocone \<alpha> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(cf_map \<FF>,-) \<circ>\<^sub>C\<^sub>F
	+ (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
	+
	+
	+text\<open>Alternative definitions.\<close>
	+
	+context is_tm_functor
	+begin
	+
	+lemma tm_cf_Cone_def':
	+ "tm_cf_Cone \<alpha> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> \<AA> \<BB>(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F op_cf (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>)"
	+ unfolding tm_cf_Cone_def cat_cs_simps by simp
	+
	+lemma tm_cf_Cocone_def':
	+ "tm_cf_Cocone \<alpha> \<FF> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> \<AA> \<BB>(cf_map \<FF>,-) \<circ>\<^sub>C\<^sub>F (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>)"
	+ unfolding tm_cf_Cocone_def cat_cs_simps by simp
	+
	+end
	+
	+
	+subsubsection\<open>Object map\<close>
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ObjMap_vsv[cat_small_cs_intros]:
	+ "vsv (tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>)"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ show ?thesis
	+ unfolding tm_cf_Cone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_Cone_ObjMap_vsv
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ObjMap_vsv[cat_small_cs_intros]:
	+ "vsv (tm_cf_Cocone \<alpha> \<FF>\<lparr>ObjMap\<rparr>)"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ show ?thesis
	+ unfolding tm_cf_Cocone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_Cocone_ObjMap_vsv
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ObjMap_vdomain[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	+proof-
	+ from assms interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cone_ObjMap_vdomain
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ObjMap_vdomain[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (tm_cf_Cocone \<alpha> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	+proof-
	+ from assms interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cocone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cocone_ObjMap_vdomain
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ObjMap_app[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
	+ Hom (cat_Funct \<alpha> \<AA> \<BB>) (cf_map (cf_const \<AA> \<BB> b)) (cf_map \<FF>)"
	+proof-
	+ from assms interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cone_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_small_cs_simps
	+ cat_cs_simps
	+ cat_FUNCT_cs_simps
	+ cat_op_simps
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cone_ObjMap_app
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ObjMap_app[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "tm_cf_Cocone \<alpha> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
	+ Hom (cat_Funct \<alpha> \<AA> \<BB>) (cf_map \<FF>) (cf_map (cf_const \<AA> \<BB> b))"
	+proof-
	+ from assms interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cocone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_small_cs_simps 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_small_cs_simps] = is_tm_functor.tm_cf_Cocone_ObjMap_app
	+
	+
	+subsubsection\<open>Arrow map\<close>
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ArrMap_vsv[cat_small_cs_intros]:
	+ "vsv (tm_cf_Cone \<alpha> \<FF>\<lparr>ArrMap\<rparr>)"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ show ?thesis
	+ unfolding tm_cf_Cone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_Cone_ArrMap_vsv
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ArrMap_vsv[cat_small_cs_intros]:
	+ "vsv (tm_cf_Cocone \<alpha> \<FF>\<lparr>ArrMap\<rparr>)"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ show ?thesis
	+ unfolding tm_cf_Cocone_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_Cocone_ArrMap_vsv
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ArrMap_vdomain[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (tm_cf_Cone \<alpha> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cone_ArrMap_vdomain
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ArrMap_vdomain[cat_small_cs_simps]:
	+ assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	+ shows "\<D>\<^sub>\<circ> (tm_cf_Cocone \<alpha> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cocone_def'
	+ by
	+ (
	+ cs_concl cs_shallow
	+ 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_small_cs_simps] = is_tm_functor.tm_cf_Cocone_ArrMap_vdomain
	+
	+lemma (in is_tm_functor) tm_cf_Cone_ArrMap_app[cat_small_cs_simps]:
	+ assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "tm_cf_Cone \<alpha> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
	+ (cat_Funct \<alpha> \<AA> \<BB>)
	+ [ntcf_arrow (ntcf_const \<AA> \<BB> f), cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>]\<^sub>\<circ>"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cone_def
	+ 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_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cone_ArrMap_app
	+
	+lemma (in is_tm_functor) tm_cf_Cocone_ArrMap_app[cat_small_cs_simps]:
	+ assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	+ shows "tm_cf_Cocone \<alpha> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
	+ (cat_Funct \<alpha> \<AA> \<BB>)
	+ [cat_Funct \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>, ntcf_arrow (ntcf_const \<AA> \<BB> f)]\<^sub>\<circ>"
	+proof-
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from assms show ?thesis
	+ unfolding tm_cf_Cocone_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps cat_op_simps
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_small_cs_simps] = is_tm_functor.tm_cf_Cocone_ArrMap_app
	+
	+
	+subsubsection\<open>Small cone functor and small cocone functor are functors\<close>
	+
	+lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor:
	+ "tm_cf_Cone \<alpha> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof-
	+ interpret \<AA>\<BB>: category \<alpha> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close>
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ interpret op_\<Delta>:
	+ is_functor \<alpha> \<open>op_cat \<BB>\<close> \<open>op_cat (cat_Funct \<alpha> \<AA> \<BB>)\<close> \<open>op_cf (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>)\<close>
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_op_intros
	+ )
	+ have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> \<AA> \<BB>(-,cf_map \<FF>) :
	+ op_cat (cat_Funct \<alpha> \<AA> \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ then show "tm_cf_Cone \<alpha> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ unfolding tm_cf_Cone_def' by (cs_concl cs_intro: cat_cs_intros)
	+qed
	+
	+lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor'[cat_small_cs_intros]:
	+ assumes "\<AA>' = op_cat \<BB>" and "\<BB>' = cat_Set \<alpha>" and "\<alpha>' = \<alpha>"
	+ shows "tm_cf_Cone \<alpha> \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	+ unfolding assms by (rule tm_cf_cf_Cone_is_functor)
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_cf_Cone_is_functor'
	+
	+lemma (in is_tm_functor) tm_cf_cf_Cocone_is_functor:
	+ "tm_cf_Cocone \<alpha> \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof-
	+ interpret Funct: category \<alpha> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close>
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ interpret \<Delta>: is_functor \<alpha> \<BB> \<open>cat_Funct \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<AA> \<BB>\<close>
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	+ have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Funct \<alpha> \<AA> \<BB>(cf_map \<FF>,-) :
	+ cat_Funct \<alpha> \<AA> \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ then show "tm_cf_Cocone \<alpha> \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ unfolding tm_cf_Cocone_def' by (cs_concl cs_intro: cat_cs_intros)
	+qed
	+
	+lemma (in is_tm_functor) tm_cf_cf_Cocone_is_functor'[cat_small_cs_intros]:
	+ assumes "\<BB>' = cat_Set \<alpha>" and "\<alpha>' = \<alpha>"
	+ shows "tm_cf_Cocone \<alpha> \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	+ unfolding assms by (rule tm_cf_cf_Cocone_is_functor)
	+
	+lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_cf_Cocone_is_functor'
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_NTCF.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_NTCF.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_NTCF.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Small_NTCF.thy
	@@ -1,760 +1,760 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Smallness for natural transformations\<close>
	theory CZH_ECAT_Small_NTCF
	imports
	CZH_Foundations.CZH_SMC_Small_NTSMCF
	CZH_ECAT_Small_Functor
	CZH_ECAT_NTCF
	begin



	subsection\<open>Natural transformation of functors with tiny maps\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale is_tm_ntcf = is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
	assumes tm_ntcf_is_tm_ntsmcf: "ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

	syntax "_is_tm_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
	"CONST is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

	abbreviation all_tm_ntcfs :: "V \<Rightarrow> V"
	where "all_tm_ntcfs \<alpha> \<equiv>
	set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation tm_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "tm_ntcfs \<alpha> \<AA> \<BB> \<equiv>
	set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation these_tm_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "these_tm_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv>
	set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemma (in is_tm_ntcf) tm_ntcf_is_tm_ntsmcf':
	assumes "\<FF>' = cf_smcf \<FF>"
	and "\<GG>' = cf_smcf \<GG>"
	and "\<AA>' = cat_smc \<AA>"
	and "\<BB>' = cat_smc \<BB>"
	shows "ntcf_ntsmcf \<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule tm_ntcf_is_tm_ntsmcf)

	lemmas [slicing_intros] = is_tm_ntcf.tm_ntcf_is_tm_ntsmcf'


	text\<open>Rules.\<close>

	lemma (in is_tm_ntcf) is_tm_ntcf_axioms'[cat_small_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
	shows "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_tm_ntcf_axioms)

	mk_ide rf is_tm_ntcf_def[unfolded is_tm_ntcf_axioms_def]
	\|intro is_tm_ntcfI\|
	\|dest is_tm_ntcfD[dest]\|
	\|elim is_tm_ntcfE[elim]\|

	lemmas [cat_small_cs_intros] = is_tm_ntcfD(1)

	context is_tm_ntcf
	begin

	interpretation ntsmcf: is_tm_ntsmcf
	\<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close> \<open>cf_smcf \<GG>\<close> \<open>ntcf_ntsmcf \<NN>\<close>
	by (rule tm_ntcf_is_tm_ntsmcf)

	lemmas_with [unfolded slicing_simps]:
	tm_ntcf_NTMap_in_Vset = ntsmcf.tm_ntsmcf_NTMap_in_Vset

	end

	sublocale is_tm_ntcf \<subseteq> NTDom: is_tm_functor \<alpha> \<AA> \<BB> \<FF>
	using tm_ntcf_is_tm_ntsmcf
	by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')

	sublocale is_tm_ntcf \<subseteq> NTCod: is_tm_functor \<alpha> \<AA> \<BB> \<GG>
	using tm_ntcf_is_tm_ntsmcf
	by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')


	text\<open>Further rules.\<close>

	lemma is_tm_ntcfI':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<FF>: is_tm_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	interpret \<GG>: is_tm_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(3))
	show ?thesis
	proof(intro is_tm_ntcfI)
	show "ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
	by (intro is_tm_ntsmcfI') (auto intro: slicing_intros)
	qed (auto intro: cat_cs_intros)
	qed

	lemma is_tm_ntcfD':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto simp: cat_small_cs_intros)
	qed

	lemmas [cat_small_cs_intros] = is_tm_ntcfD'(2,3)

	lemma is_tm_ntcfE':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	using is_tm_ntcfD'[OF assms] by auto


	text\<open>The set of all natural transformations with tiny maps is small.\<close>

	lemma small_all_tm_ntcfs[simp]:
	"small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(rule down)
	show
	"{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
	elts (set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
	proof
	(
	simp only: elts_of_set small_all_ntcfs if_True,
	rule subsetI,
	unfold mem_Collect_eq
	)
	fix \<NN> assume "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	then obtain \<FF> \<GG> \<AA> \<BB> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then interpret is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by simp
	have "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (auto simp: cat_cs_intros)
	then show "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
	qed
	qed

	lemma small_tm_ntcfs[simp]:
	"small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}\<close>])
	auto

	lemma small_these_tm_ntcfs[simp]:
	"small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}\<close>])
	auto


	text\<open>Further elementary results.\<close>

	lemma these_tm_ntcfs_iff: (not simp)
	"\<NN> \<in>\<^sub>\<circ> these_tm_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto


	subsubsection\<open>Opposite natural transformation of functors with tiny maps\<close>

	lemma (in is_tm_ntcf) is_tm_ntcf_op: "op_ntcf \<NN> :
	op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (intro is_tm_ntcfI')
	(cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+

	lemma (in is_tm_ntcf) is_tm_ntcf_op'[cat_op_intros]:
	assumes "\<GG>' = op_cf \<GG>"
	and "\<FF>' = op_cf \<FF>"
	and "\<AA>' = op_cat \<AA>"
	and "\<BB>' = op_cat \<BB>"
	shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_tm_ntcf_op)

	lemmas is_tm_ntcf_op[cat_op_intros] = is_tm_ntcf.is_tm_ntcf_op'


	subsubsection\<open>
	Vertical composition of natural transformations of
	functors with tiny maps
	\<close>

	lemma ntcf_vcomp_is_tm_ntcf[cat_small_cs_intros]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<MM>: is_tm_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis
	by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
	qed


	subsubsection\<open>Identity natural transformation of a functor with tiny maps\<close>

	lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf:
	"ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)

	lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf':
	assumes "\<FF>' = \<FF>" and "\<GG>' = \<FF>"
	shows "ntcf_id \<FF> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>': \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms(1,2) by (rule tm_cf_ntcf_id_is_tm_ntcf)

	lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_ntcf_id_is_tm_ntcf'


	subsubsection\<open>Constant natural transformation of functors with tiny maps\<close>

	lemma ntcf_const_is_tm_ntcf:
	assumes "tiny_category \<alpha> \<JJ>" and "category \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "ntcf_const \<JJ> \<CC> f :
	cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	(is \<open>?Cf : ?Ca \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m ?Cb : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	proof(intro is_tm_ntcfI')
	interpret \<JJ>: tiny_category \<alpha> \<JJ> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	from assms show
	"?Cf : ?Ca \<mapsto>\<^sub>C\<^sub>F ?Cb : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	"cf_const \<JJ> \<CC> a : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	"cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
	qed

	lemma ntcf_const_is_tm_ntcf'[cat_small_cs_intros]:
	assumes "tiny_category \<alpha> \<JJ>"
	and "category \<alpha> \<CC>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<AA> = cf_const \<JJ> \<CC> a"
	and "\<BB> = cf_const \<JJ> \<CC> b"
	and "\<JJ>' = \<JJ>"
	and "\<CC>' = \<CC>"
	shows "ntcf_const \<JJ> \<CC> f : \<AA> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<BB> : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_tm_ntcf)


	subsubsection\<open>Natural isomorphisms of functors with tiny maps\<close>

	locale is_tm_iso_ntcf = is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> + is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>
	for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>

	syntax "_is_tm_iso_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ : _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o _ : _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
	"CONST is_tm_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"


	text\<open>Rules.\<close>

	mk_ide rf is_tm_iso_ntcf_def
	\|intro is_tm_iso_ntcfI\|
	\|dest is_tm_iso_ntcfD[dest]\|
	\|elim is_tm_iso_ntcfE[elim]\|

	lemmas [ntcf_cs_intros] = is_tm_iso_ntcfD

	-lemma iso_tm_ntcf_is_arr_isomorphism:
	+lemma iso_tm_ntcf_is_iso_arr:
	assumes "category \<alpha> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [ntcf_cs_intros]: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
	and "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	proof-
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<NN>: is_tm_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms)
	- note inv_\<NN> = iso_ntcf_is_arr_isomorphism[OF \<NN>.is_iso_ntcf_axioms]
	+ note inv_\<NN> = iso_ntcf_is_iso_arr[OF \<NN>.is_iso_ntcf_axioms]
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(intro is_tm_iso_ntcfI)
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (intro inv_\<NN>(1))
	interpret inv_\<NN>: is_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close> by (rule inv_\<NN>(1))
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
	qed
	show "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>" "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	by (intro inv_\<NN>(2,3))+
	qed

	-lemma is_arr_isomorphism_is_tm_iso_ntcf:
	+lemma is_iso_arr_is_tm_iso_ntcf:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and [simp]: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> = ntcf_id \<GG>"
	and [simp]: "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<MM>: is_tm_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<MM> by (rule assms(2))
	show ?thesis
	proof(rule is_tm_iso_ntcfI)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	- by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
	+ by (rule is_iso_arr_is_iso_ntcf) (auto intro: cat_small_cs_intros)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	by (rule is_tm_ntcfI')
	(auto simp: \<NN>.tm_ntcf_NTMap_in_Vset intro: cat_small_cs_intros)
	qed
	qed


	subsubsection\<open>
	Composition of a natural transformation
	of functors with tiny maps and a functor with tiny maps
	\<close>

	lemma ntcf_cf_comp_is_tm_ntcf:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<NN>: is_tm_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<HH>: is_tm_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
	from assms show ?thesis
	by (intro is_tm_ntcfI)
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
	)+
	qed

	lemma ntcf_cf_comp_is_tm_ntcf'[cat_small_cs_intros]:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = \<FF> \<circ>\<^sub>C\<^sub>F \<HH>"
	and "\<GG>' = \<GG> \<circ>\<^sub>C\<^sub>F \<HH>"
	shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (rule ntcf_cf_comp_is_tm_ntcf)


	subsubsection\<open>
	Composition of a functor with tiny maps
	and a natural transformation of functors with tiny maps
	\<close>

	lemma cf_ntcf_comp_is_tm_ntcf:
	assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<HH> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
	interpret \<NN>: is_tm_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	from assms show ?thesis
	by (intro is_tm_ntcfI)
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
	)+
	qed

	lemma cf_ntcf_comp_is_tm_ntcf'[cat_small_cs_intros]:
	assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF>' = \<HH> \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<GG>' = \<HH> \<circ>\<^sub>C\<^sub>F \<GG>"
	shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2) unfolding assms(3,4) by (rule cf_ntcf_comp_is_tm_ntcf)



	subsection\<open>Tiny natural transformation of functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale is_tiny_ntcf = is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
	assumes tiny_ntcf_is_tiny_ntsmcf:
	"ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

	syntax "_is_tiny_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
	"CONST is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

	abbreviation all_tiny_ntcfs :: "V \<Rightarrow> V"
	where "all_tiny_ntcfs \<alpha> \<equiv>
	set {\<NN>. \<exists>\<AA> \<BB> \<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation tiny_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "tiny_ntcfs \<alpha> \<AA> \<BB> \<equiv>
	set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation these_tiny_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "these_tiny_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv>
	set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemma (in is_tiny_ntcf) tiny_ntcf_is_tiny_ntsmcf':
	assumes "\<alpha>' = \<alpha>"
	and "\<FF>' = cf_smcf \<FF>"
	and "\<GG>' = cf_smcf \<GG>"
	and "\<AA>' = cat_smc \<AA>"
	and "\<BB>' = cat_smc \<BB>"
	shows "ntcf_ntsmcf \<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule tiny_ntcf_is_tiny_ntsmcf)

	lemmas [slicing_intros] = is_tiny_ntcf.tiny_ntcf_is_tiny_ntsmcf'


	text\<open>Rules.\<close>

	lemma (in is_tiny_ntcf) is_tiny_ntcf_axioms'[cat_small_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule is_tiny_ntcf_axioms)

	mk_ide rf is_tiny_ntcf_def[unfolded is_tiny_ntcf_axioms_def]
	\|intro is_tiny_ntcfI\|
	\|dest is_tiny_ntcfD[dest]\|
	\|elim is_tiny_ntcfE[elim]\|


	text\<open>Elementary properties.\<close>

	sublocale is_tiny_ntcf \<subseteq> NTDom: is_tiny_functor \<alpha> \<AA> \<BB> \<FF>
	using tiny_ntcf_is_tiny_ntsmcf
	by (intro is_tiny_functorI)
	(auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)

	sublocale is_tiny_ntcf \<subseteq> NTCod: is_tiny_functor \<alpha> \<AA> \<BB> \<GG>
	using tiny_ntcf_is_tiny_ntsmcf
	by (intro is_tiny_functorI)
	(auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)

	sublocale is_tiny_ntcf \<subseteq> is_tm_ntcf
	by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)

	lemmas (in is_tiny_ntcf) tiny_ntcf_is_tm_ntcf[cat_small_cs_intros] =
	is_tm_ntcf_axioms

	lemmas [cat_small_cs_intros] = is_tiny_ntcf.tiny_ntcf_is_tm_ntcf


	text\<open>Further rules.\<close>

	lemma is_tiny_ntcfI':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<FF>: is_tiny_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	interpret \<GG>: is_tiny_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(3))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tiny_ntcfI is_tiny_ntsmcfI')
	(auto intro: cat_cs_intros slicing_intros)
	qed

	lemma is_tiny_ntcfD':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto intro: cat_small_cs_intros)
	qed

	lemmas [cat_small_cs_intros] = is_tiny_ntcfD'(2,3)

	lemma is_tiny_ntcfE':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (auto dest: is_tiny_ntcfD'(2,3))

	lemma is_tiny_ntcf_iff:
	"\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<longleftrightarrow>
	(
	\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB> \<and>
	\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<and>
	\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>
	)"
	by (auto intro: is_tiny_ntcfI' dest: is_tiny_ntcfD'(2,3))

	lemma (in is_tiny_ntcf) tiny_ntcf_in_Vset: "\<NN> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note [cat_cs_intros] =
	tm_ntcf_NTMap_in_Vset
	NTDom.tiny_cf_in_Vset
	NTCod.tiny_cf_in_Vset
	NTDom.HomDom.tiny_cat_in_Vset
	NTDom.HomCod.tiny_cat_in_Vset
	show ?thesis
	by (subst ntcf_def)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros
	)
	qed

	lemma small_all_tiny_ntcfs[simp]:
	"small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(rule down)
	show "{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
	elts (set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
	proof
	(
	simp only: elts_of_set small_all_ntcfs if_True,
	rule subsetI,
	unfold mem_Collect_eq
	)
	fix \<NN> assume "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	then obtain \<FF> \<GG> \<AA> \<BB> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then interpret is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> .
	have "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (auto intro: cat_cs_intros)
	then show "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
	qed
	qed

	lemma small_tiny_ntcfs[simp]:
	"small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
	by
	(
	rule
	down[
	of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
	]
	)
	auto

	lemma small_these_tiny_ntcfs[simp]:
	"small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
	by
	(
	rule
	down[
	of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
	]
	)
	auto

	lemma tiny_ntcfs_vsubset_Vset[simp]:
	"set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	(is \<open>set ?ntcfs \<subseteq>\<^sub>\<circ> _\<close>)
	proof(cases \<open>tiny_category \<alpha> \<AA> \<and> tiny_category \<alpha> \<BB>\<close>)
	case True
	then have "tiny_category \<alpha> \<AA>" and "tiny_category \<alpha> \<BB>" by auto
	show ?thesis
	proof(rule vsubsetI)
	fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> set ?ntcfs"
	then obtain \<FF> \<GG> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" by auto
	then interpret is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by simp
	from tiny_ntcf_in_Vset show "\<NN> \<in>\<^sub>\<circ> Vset \<alpha>" by simp
	qed
	next
	case False
	then have "set ?ntcfs = 0"
	unfolding is_tiny_ntcf_iff is_tiny_functor_iff by auto
	then show ?thesis by simp
	qed


	text\<open>Further elementary results.\<close>

	lemma these_tiny_ntcfs_iff: (not simp)
	"\<NN> \<in>\<^sub>\<circ> these_tiny_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by auto


	text\<open>Size.\<close>

	lemma (in is_ntcf) ntcf_is_tiny_ntcf_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>"
	proof(intro is_tiny_ntcfI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
	by (intro ntcf_is_ntcf_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: dg_cs_intros\<close>)+
	show "ntcf_ntsmcf \<NN> :
	cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_smc \<BB>"
	by
	(
	rule is_ntsmcf.ntsmcf_is_tiny_ntsmcf_if_ge_Limit,
	rule ntcf_is_ntsmcf;
	intro assms
	)
	qed


	subsubsection\<open>Opposite natural transformation of tiny functors\<close>

	lemma (in is_tiny_ntcf) is_tm_ntcf_op: "op_ntcf \<NN> :
	op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by (intro is_tiny_ntcfI')
	(cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+

	lemma (in is_tiny_ntcf) is_tiny_ntcf_op'[cat_op_intros]:
	assumes "\<GG>' = op_cf \<GG>"
	and "\<FF>' = op_cf \<FF>"
	and "\<AA>' = op_cat \<AA>"
	and "\<BB>' = op_cat \<BB>"
	shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_tm_ntcf_op)

	lemmas is_tiny_ntcf_op[cat_op_intros] = is_tiny_ntcf.is_tiny_ntcf_op'


	subsubsection\<open>Vertical composition of tiny natural transformations\<close>

	lemma ntsmcf_vcomp_is_tiny_ntsmcf[cat_small_cs_intros]:
	assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<MM>: is_tiny_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
	show ?thesis by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
	qed


	subsubsection\<open>Tiny identity natural transformation\<close>

	lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf:
	"ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros)

	lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf'[cat_small_cs_intros]:
	assumes "\<FF>' = \<FF>" and "\<GG>' = \<FF>"
	shows "ntcf_id \<FF> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule tiny_cf_ntcf_id_is_tiny_ntcf)

	lemmas [cat_small_cs_intros] = is_tiny_functor.tiny_cf_ntcf_id_is_tiny_ntcf'



	subsection\<open>Tiny natural isomorphisms\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale is_tiny_iso_ntcf = is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> + is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>
	for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>

	syntax "_is_tiny_iso_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ : _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o _ : _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
	"CONST is_tiny_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"


	text\<open>Rules.\<close>

	mk_ide rf is_tiny_iso_ntcf_def
	\|intro is_tiny_iso_ntcfI\|
	\|dest is_tiny_iso_ntcfD[dest]\|
	\|elim is_tiny_iso_ntcfE[elim]\|

	lemmas [ntcf_cs_intros] = is_tiny_iso_ntcfD(2)


	text\<open>Elementary properties.\<close>

	sublocale is_tiny_iso_ntcf \<subseteq> is_tm_iso_ntcf
	by (rule is_tm_iso_ntcfI) (auto intro: cat_cs_intros cat_small_cs_intros)

	lemmas (in is_tiny_iso_ntcf) is_tm_iso_ntcf_axioms' = is_tm_iso_ntcf_axioms

	lemmas [ntcf_cs_intros] = is_tiny_iso_ntcf.is_tm_iso_ntcf_axioms'


	text\<open>Further rules.\<close>

	lemma is_tiny_iso_ntcfI':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<FF>: is_tiny_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	interpret \<GG>: is_tiny_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(3))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tiny_iso_ntcfI is_tiny_ntcfI')
	(auto intro: cat_cs_intros cat_small_cs_intros)
	qed

	lemma is_tiny_iso_ntcfD':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_tiny_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto intro: cat_cs_intros cat_small_cs_intros)
	qed

	lemma is_tiny_iso_ntcfE':
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (auto dest: is_tiny_ntcfD'(2,3))

	lemma is_tiny_iso_ntcf_iff:
	"\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<longleftrightarrow>
	(
	\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB> \<and>
	\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<and>
	\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>
	)"
	by (auto intro: is_tiny_iso_ntcfI' dest: is_tiny_ntcfD'(2,3))


	subsubsection\<open>Further properties\<close>

	-lemma iso_tiny_ntcf_is_arr_isomorphism:
	+lemma iso_tiny_ntcf_is_iso_arr:
	assumes "category \<alpha> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [ntcf_cs_intros]: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
	and "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	proof-
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<NN>: is_tiny_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms)
	- note inv_\<NN> = iso_ntcf_is_arr_isomorphism[OF \<NN>.is_iso_ntcf_axioms]
	+ note inv_\<NN> = iso_ntcf_is_iso_arr[OF \<NN>.is_iso_ntcf_axioms]
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(intro is_tiny_iso_ntcfI)
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (intro inv_\<NN>(1))
	interpret inv_\<NN>: is_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close> by (rule inv_\<NN>(1))
	show "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros cat_cs_intros)
	qed
	show "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>" "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	by (intro inv_\<NN>(2,3))+
	qed

	-lemma is_arr_isomorphism_is_tiny_iso_ntcf:
	+lemma is_iso_arr_is_tiny_iso_ntcf:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	and [simp]: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> = ntcf_id \<GG>"
	and [simp]: "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
	shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<NN>: is_tiny_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
	interpret \<MM>: is_tiny_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<MM> by (rule assms(2))
	show ?thesis
	proof(rule is_tiny_iso_ntcfI)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	- by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
	+ by (rule is_iso_arr_is_iso_ntcf) (auto intro: cat_small_cs_intros)
	show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
	by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
	qed
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Structure_Example.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Structure_Example.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Structure_Example.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Structure_Example.thy
	@@ -1,2373 +1,2373 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Example: categories with additional structure\<close>
	theory CZH_ECAT_Structure_Example
	imports
	CZH_ECAT_Introduction
	CZH_ECAT_PCategory
	CZH_ECAT_Set
	begin



	subsection\<open>Background\<close>


	text\<open>
	The examples that are presented in this section showcase
	how the framework developed in this article can
	be used for the formalization of the theory of
	categories with additional structure. The content of
	this section also indicates some of the potential
	future directions for this body of work.
	\<close>



	subsection\<open>Dagger category\<close>

	named_theorems dag_field_simps

	named_theorems dagcat_cs_simps
	named_theorems dagcat_cs_intros

	definition DagCat :: V where [dag_field_simps]: "DagCat = 0"
	definition DagDag :: V where [dag_field_simps]: "DagDag = 1\<^sub>\<nat>"

	abbreviation DagDag_app :: "V \<Rightarrow> V" (\<open>\<dagger>\<^sub>C\<close>)
	where "\<dagger>\<^sub>C \<CC> \<equiv> \<CC>\<lparr>DagDag\<rparr>"


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	For further information see
	\cite{noauthor_nlab_nodate}\footnote{\url{
	https://ncatlab.org/nlab/show/dagger+category
	}}.
	\<close>

	locale dagger_category =
	\<Z> \<alpha> +
	vfsequence \<CC> +
	DagCat: category \<alpha> \<open>\<CC>\<lparr>DagCat\<rparr>\<close> +
	DagDag: is_functor \<alpha> \<open>op_cat (\<CC>\<lparr>DagCat\<rparr>)\<close> \<open>\<CC>\<lparr>DagCat\<rparr>\<close> \<open>\<dagger>\<^sub>C \<CC>\<close>
	for \<alpha> \<CC> +
	assumes dagcat_length: "vcard \<CC> = 2\<^sub>\<nat>"
	and dagcat_ObjMap_identity[dagcat_cs_simps]:
	"a \<in>\<^sub>\<circ> \<CC>\<lparr>DagCat\<rparr>\<lparr>Obj\<rparr> \<Longrightarrow> (\<dagger>\<^sub>C \<CC>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = a"
	and dagcat_DagCat_idem[dagcat_cs_simps]:
	"\<dagger>\<^sub>C \<CC> \<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>C \<CC> = cf_id (\<CC>\<lparr>DagCat\<rparr>)"

	lemmas [dagcat_cs_simps] =
	dagger_category.dagcat_ObjMap_identity
	dagger_category.dagcat_DagCat_idem


	text\<open>Rules.\<close>

	lemma (in dagger_category) dagger_category_axioms'[dagcat_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "dagger_category \<alpha>' \<CC>"
	unfolding assms by (rule dagger_category_axioms)

	mk_ide rf dagger_category_def[unfolded dagger_category_axioms_def]
	\|intro dagger_categoryI\|
	\|dest dagger_categoryD[dest]\|
	\|elim dagger_categoryE[elim]\|

	lemma category_if_dagger_category[dagcat_cs_intros]:
	assumes "\<CC>' = (\<CC>\<lparr>DagCat\<rparr>)" and "dagger_category \<alpha> \<CC>"
	shows "category \<alpha> \<CC>'"
	unfolding assms(1) using assms(2) by (rule dagger_categoryD(3))

	lemma (in dagger_category) dagcat_is_functor'[dagcat_cs_intros]:
	assumes "\<AA>' = op_cat (\<CC>\<lparr>DagCat\<rparr>)" and "\<BB>' = \<CC>\<lparr>DagCat\<rparr>"
	shows "\<dagger>\<^sub>C \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule DagDag.is_functor_axioms)

	lemmas [dagcat_cs_intros] = dagger_category.dagcat_is_functor'



	subsection\<open>\<open>Rel\<close> as a dagger category\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	For further information see
	\cite{noauthor_nlab_nodate}\footnote{\url{
	https://ncatlab.org/nlab/show/Rel
	}}.
	\<close>

	definition dagcat_Rel :: "V \<Rightarrow> V"
	where "dagcat_Rel \<alpha> = [cat_Rel \<alpha>, \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dagcat_Rel_components:
	shows "dagcat_Rel \<alpha>\<lparr>DagCat\<rparr> = cat_Rel \<alpha>"
	and "dagcat_Rel \<alpha>\<lparr>DagDag\<rparr> = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>"
	unfolding dagcat_Rel_def dag_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>\<open>Rel\<close> is a dagger category\<close>

	lemma (in \<Z>) dagger_category_dagcat_Rel: "dagger_category \<alpha> (dagcat_Rel \<alpha>)"
	proof(intro dagger_categoryI)
	show "category \<alpha> (dagcat_Rel \<alpha>\<lparr>DagCat\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: dagcat_Rel_components cs_intro: cat_Rel_cs_intros
	)
	show "\<dagger>\<^sub>C (dagcat_Rel \<alpha>) :
	op_cat (dagcat_Rel \<alpha>\<lparr>DagCat\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> dagcat_Rel \<alpha>\<lparr>DagCat\<rparr>"
	unfolding dagcat_Rel_components
	by (cs_concl cs_intro: cf_cs_intros cat_cs_intros)
	show "vcard (dagcat_Rel \<alpha>) = 2\<^sub>\<nat>"
	unfolding dagcat_Rel_def by (simp add: nat_omega_simps)
	show "\<dagger>\<^sub>C (dagcat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = a"
	if "a \<in>\<^sub>\<circ> dagcat_Rel \<alpha>\<lparr>DagCat\<rparr>\<lparr>Obj\<rparr>" for a
	using that
	unfolding dagcat_Rel_components cat_Rel_components(1)
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_Rel_cs_simps)
	show "\<dagger>\<^sub>C (dagcat_Rel \<alpha>) \<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>C (dagcat_Rel \<alpha>) = dghm_id (dagcat_Rel \<alpha>\<lparr>DagCat\<rparr>)"
	unfolding dagcat_Rel_components
	by (cs_concl cs_shallow cs_simp: cf_cn_comp_cf_dag_Rel_cf_dag_Rel)
	qed (auto simp: dagcat_Rel_def)



	subsection\<open>Monoidal category\<close>


	text\<open>
	For background information see Chapter 2 in \cite{etingof_tensor_2015}.
	\<close>


	subsubsection\<open>Background\<close>

	named_theorems mcat_field_simps

	named_theorems mcat_cs_simps
	named_theorems mcat_cs_intros

	definition Mcat :: V where [mcat_field_simps]: "Mcat = 0"
	definition Mcf :: V where [mcat_field_simps]: "Mcf = 1\<^sub>\<nat>"
	definition Me :: V where [mcat_field_simps]: "Me = 2\<^sub>\<nat>"
	definition M\<alpha> :: V where [mcat_field_simps]: "M\<alpha> = 3\<^sub>\<nat>"
	definition Ml :: V where [mcat_field_simps]: "Ml = 4\<^sub>\<nat>"
	definition Mr :: V where [mcat_field_simps]: "Mr = 5\<^sub>\<nat>"


	subsubsection\<open>Definition and elementary properties\<close>

	locale monoidal_category =
	\<comment>\<open>See Definition 2.2.8 in \cite{etingof_tensor_2015}.\<close>
	\<Z> \<alpha> +
	vfsequence \<CC> +
	Mcat: category \<alpha> \<open>\<CC>\<lparr>Mcat\<rparr>\<close> +
	Mcf: is_functor \<alpha> \<open>(\<CC>\<lparr>Mcat\<rparr>) \<times>\<^sub>C (\<CC>\<lparr>Mcat\<rparr>)\<close> \<open>\<CC>\<lparr>Mcat\<rparr>\<close> \<open>\<CC>\<lparr>Mcf\<rparr>\<close> +
	M\<alpha>: is_iso_ntcf
	\<alpha> \<open>\<CC>\<lparr>Mcat\<rparr>^\<^sub>C\<^sub>3\<close> \<open>\<CC>\<lparr>Mcat\<rparr>\<close> \<open>cf_blcomp (\<CC>\<lparr>Mcf\<rparr>)\<close> \<open>cf_brcomp (\<CC>\<lparr>Mcf\<rparr>)\<close> \<open>\<CC>\<lparr>M\<alpha>\<rparr>\<close> +
	Ml: is_iso_ntcf
	\<alpha>
	\<open>\<CC>\<lparr>Mcat\<rparr>\<close>
	\<open>\<CC>\<lparr>Mcat\<rparr>\<close>
	\<open>\<CC>\<lparr>Mcf\<rparr>\<^bsub>\<CC>\<lparr>Mcat\<rparr>,\<CC>\<lparr>Mcat\<rparr>\<^esub>(\<CC>\<lparr>Me\<rparr>,-)\<^sub>C\<^sub>F\<close>
	\<open>cf_id (\<CC>\<lparr>Mcat\<rparr>)\<close>
	\<open>\<CC>\<lparr>Ml\<rparr>\<close> +
	Mr: is_iso_ntcf
	\<alpha>
	\<open>\<CC>\<lparr>Mcat\<rparr>\<close>
	\<open>\<CC>\<lparr>Mcat\<rparr>\<close>
	\<open>\<CC>\<lparr>Mcf\<rparr>\<^bsub>\<CC>\<lparr>Mcat\<rparr>,\<CC>\<lparr>Mcat\<rparr>\<^esub>(-,\<CC>\<lparr>Me\<rparr>)\<^sub>C\<^sub>F\<close>
	\<open>cf_id (\<CC>\<lparr>Mcat\<rparr>)\<close>
	\<open>\<CC>\<lparr>Mr\<rparr>\<close>
	for \<alpha> \<CC> +
	assumes mcat_length[mcat_cs_simps]: "vcard \<CC> = 6\<^sub>\<nat>"
	and mcat_Me_is_obj[mcat_cs_intros]: "\<CC>\<lparr>Me\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	and mcat_pentagon:
	"\<lbrakk>
	a \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>;
	b \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>;
	c \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>;
	d \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>
	\<rbrakk> \<Longrightarrow>
	(\<CC>\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> \<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>b, c, d\<rparr>\<^sub>\<bullet>) \<circ>\<^sub>A\<^bsub>\<CC>\<lparr>Mcat\<rparr>\<^esub>
	\<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, b \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> c, d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<lparr>Mcat\<rparr>\<^esub>
	(\<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, b, c\<rparr>\<^sub>\<bullet> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> \<CC>\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>d\<rparr>) =
	\<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, b, c \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<lparr>Mcat\<rparr>\<^esub>
	\<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> b, c, d\<rparr>\<^sub>\<bullet>"
	and mcat_triangle[mcat_cs_simps]:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<CC>\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	(\<CC>\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> \<CC>\<lparr>Ml\<rparr>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<lparr>Mcat\<rparr>\<^esub>
	\<CC>\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, \<CC>\<lparr>Me\<rparr>, b\<rparr>\<^sub>\<bullet> =
	(\<CC>\<lparr>Mr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>Mcf\<rparr>\<^esub> \<CC>\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>b\<rparr>)"

	lemmas [mcat_cs_intros] = monoidal_category.mcat_Me_is_obj
	lemmas [mcat_cs_simps] = monoidal_category.mcat_triangle


	text\<open>Rules.\<close>

	lemma (in monoidal_category) monoidal_category_axioms'[mcat_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "monoidal_category \<alpha>' \<CC>"
	unfolding assms by (rule monoidal_category_axioms)

	mk_ide rf monoidal_category_def[unfolded monoidal_category_axioms_def]
	\|intro monoidal_categoryI\|
	\|dest monoidal_categoryD[dest]\|
	\|elim monoidal_categoryE[elim]\|


	text\<open>Elementary properties.\<close>

	lemma mcat_eqI:
	assumes "monoidal_category \<alpha> \<AA>"
	and "monoidal_category \<alpha> \<BB>"
	and "\<AA>\<lparr>Mcat\<rparr> = \<BB>\<lparr>Mcat\<rparr>"
	and "\<AA>\<lparr>Mcf\<rparr> = \<BB>\<lparr>Mcf\<rparr>"
	and "\<AA>\<lparr>Me\<rparr> = \<BB>\<lparr>Me\<rparr>"
	and "\<AA>\<lparr>M\<alpha>\<rparr> = \<BB>\<lparr>M\<alpha>\<rparr>"
	and "\<AA>\<lparr>Ml\<rparr> = \<BB>\<lparr>Ml\<rparr>"
	and "\<AA>\<lparr>Mr\<rparr> = \<BB>\<lparr>Mr\<rparr>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>: monoidal_category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: monoidal_category \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<AA> = 6\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: mcat_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>"
	by (cs_concl cs_shallow cs_simp: mcat_cs_simps V_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<AA> \<Longrightarrow> \<AA>\<lparr>a\<rparr> = \<BB>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms)
	(auto simp: mcat_field_simps)
	qed auto
	qed



	subsection\<open>Components for \<open>M\<alpha>\<close> for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition M\<alpha>_Rel_arrow_lr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "M\<alpha>_Rel_arrow_lr A B C =
	[
	(\<lambda>ab_c\<in>\<^sub>\<circ>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C. \<langle>vfst (vfst ab_c), \<langle>vsnd (vfst ab_c), vsnd ab_c\<rangle>\<rangle>),
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C,
	A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)
	]\<^sub>\<circ>"

	definition M\<alpha>_Rel_arrow_rl :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "M\<alpha>_Rel_arrow_rl A B C =
	[
	(\<lambda>a_bc\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C). \<langle>\<langle>vfst a_bc, vfst (vsnd a_bc)\<rangle>, vsnd (vsnd a_bc)\<rangle>),
	A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C),
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma M\<alpha>_Rel_arrow_lr_components:
	shows "M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrVal\<rparr> =
	(\<lambda>ab_c\<in>\<^sub>\<circ>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C. \<langle>vfst (vfst ab_c), \<langle>vsnd (vfst ab_c), vsnd ab_c\<rangle>\<rangle>)"
	and [cat_cs_simps]: "M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrDom\<rparr> = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and [cat_cs_simps]: "M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrCod\<rparr> = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	unfolding M\<alpha>_Rel_arrow_lr_def arr_field_simps by (simp_all add: nat_omega_simps)

	lemma M\<alpha>_Rel_arrow_rl_components:
	shows "M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrVal\<rparr> =
	(\<lambda>a_bc\<in>\<^sub>\<circ>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C). \<langle>\<langle>vfst a_bc, vfst (vsnd a_bc)\<rangle>, vsnd (vsnd a_bc)\<rangle>)"
	and [cat_cs_simps]: "M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrDom\<rparr> = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and [cat_cs_simps]: "M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrCod\<rparr> = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	unfolding M\<alpha>_Rel_arrow_rl_def arr_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow value\<close>

	mk_VLambda M\<alpha>_Rel_arrow_lr_components(1)
	\|vsv M\<alpha>_Rel_arrow_lr_ArrVal_vsv[cat_cs_intros]\|
	\|vdomain M\<alpha>_Rel_arrow_lr_ArrVal_vdomain[cat_cs_simps]\|
	\|app M\<alpha>_Rel_arrow_lr_ArrVal_app'\|

	lemma M\<alpha>_Rel_arrow_lr_ArrVal_app[cat_cs_simps]:
	assumes "ab_c = \<langle>\<langle>a, b\<rangle>, c\<rangle>" and "ab_c \<in>\<^sub>\<circ> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	shows "M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrVal\<rparr>\<lparr>ab_c\<rparr> = \<langle>a, \<langle>b, c\<rangle>\<rangle>"
	using assms(2)
	unfolding assms(1)
	by (simp_all add: M\<alpha>_Rel_arrow_lr_ArrVal_app' nat_omega_simps)

	mk_VLambda M\<alpha>_Rel_arrow_rl_components(1)
	\|vsv M\<alpha>_Rel_arrow_rl_ArrVal_vsv[cat_cs_intros]\|
	\|vdomain M\<alpha>_Rel_arrow_rl_ArrVal_vdomain[cat_cs_simps]\|
	\|app M\<alpha>_Rel_arrow_rl_ArrVal_app'\|

	lemma M\<alpha>_Rel_arrow_rl_ArrVal_app[cat_cs_simps]:
	assumes "a_bc = \<langle>a, \<langle>b, c\<rangle>\<rangle>" and "a_bc \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	shows "M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrVal\<rparr>\<lparr>a_bc\<rparr> = \<langle>\<langle>a, b\<rangle>, c\<rangle>"
	using assms(2)
	unfolding assms(1)
	by (simp_all add: M\<alpha>_Rel_arrow_rl_ArrVal_app' nat_omega_simps)


	subsubsection\<open>Components for \<open>M\<alpha>\<close> for \<open>Rel\<close> are arrows\<close>

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_Vset:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "C \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	proof(intro cat_Set_is_arrI arr_SetI)
	show "vfsequence (M\<alpha>_Rel_arrow_lr A B C)" unfolding M\<alpha>_Rel_arrow_lr_def by auto
	show "vcard (M\<alpha>_Rel_arrow_lr A B C) = 3\<^sub>\<nat>"
	unfolding M\<alpha>_Rel_arrow_lr_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> M\<alpha>_Rel_arrow_lr A B C\<lparr>ArrCod\<rparr>"
	unfolding M\<alpha>_Rel_arrow_lr_components by auto
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	\<close>
	)+

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_Vset:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "C \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof(intro cat_Set_is_arrI arr_SetI)
	show "vfsequence (M\<alpha>_Rel_arrow_rl A B C)" unfolding M\<alpha>_Rel_arrow_rl_def by auto
	show "vcard (M\<alpha>_Rel_arrow_rl A B C) = 3\<^sub>\<nat>"
	unfolding M\<alpha>_Rel_arrow_rl_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> M\<alpha>_Rel_arrow_rl A B C\<lparr>ArrCod\<rparr>"
	unfolding M\<alpha>_Rel_arrow_rl_components by auto
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	\<close>
	)+

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Set_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	using assms
	unfolding cat_Set_components
	by (rule M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_Vset)

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Set \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_lr_is_cat_Set_arr)

	lemmas [cat_rel_par_Set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Set_arr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Set_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	using assms
	unfolding cat_Set_components
	by (rule M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_Vset)

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Set \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_rl_is_cat_Set_arr)

	lemmas [cat_rel_par_Set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Set_arr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Par_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	from assms show ?thesis
	unfolding cat_Par_components(1)
	by (intro Set_Par.subcat_is_arrD M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Par \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_lr_is_cat_Par_arr)

	lemmas [cat_rel_Par_set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Par_arr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Par_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Par \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	from assms show ?thesis
	unfolding cat_Par_components(1)
	by (intro Set_Par.subcat_is_arrD M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Par \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_rl_is_cat_Par_arr)

	lemmas [cat_rel_Par_set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Par_arr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule subcat_trans[
	OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
	]
	)
	from assms show ?thesis
	unfolding cat_Rel_components(1)
	by (intro Set_Rel.subcat_is_arrD M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr)

	lemmas [cat_Rel_par_set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule subcat_trans[
	OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
	]
	)
	from assms show ?thesis
	unfolding cat_Rel_components(1)
	by (intro Set_Rel.subcat_is_arrD M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3) unfolding assms(4-6) by (rule M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr)

	lemmas [cat_Rel_par_set_cs_intros] = \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr'


	subsubsection\<open>Further properties\<close>

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_M\<alpha>_Rel_arrow_lr[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "C \<in>\<^sub>\<circ> Vset \<alpha>"
	shows
	"M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>"
	proof-
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms have lhs:
	"M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C :
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1)
	cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C)\<lparr>ArrVal\<rparr>) =
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms Set.category_axioms have rhs:
	"cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr> :
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>)\<lparr>ArrVal\<rparr>) = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs:
	"arr_Set \<alpha> (M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C)"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C)\<lparr>ArrVal\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix ab_c assume prems: "ab_c \<in>\<^sub>\<circ> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	then obtain a b c
	where ab_c_def: "ab_c = \<langle>\<langle>a, b\<rangle>, c\<rangle>"
	and a: "a \<in>\<^sub>\<circ> A"
	and b: "b \<in>\<^sub>\<circ> B"
	and c: "c \<in>\<^sub>\<circ> C"
	by clarsimp
	from assms prems a b c lhs rhs show
	"(M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C)\<lparr>ArrVal\<rparr>\<lparr>ab_c\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>\<lparr>ArrVal\<rparr>\<lparr>ab_c\<rparr>"
	unfolding ab_c_def
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cat_cs_simps
	cs_intro: cat_rel_par_Set_cs_intros V_cs_intros cat_cs_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed (use lhs rhs in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_rl_M\<alpha>_Rel_arrow_lr'[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows
	"M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>"
	using assms
	unfolding cat_Set_components(1)
	by (rule M\<alpha>_Rel_arrow_rl_M\<alpha>_Rel_arrow_lr)

	lemmas [cat_cs_simps] = \<Z>.M\<alpha>_Rel_arrow_rl_M\<alpha>_Rel_arrow_lr'

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_M\<alpha>_Rel_arrow_rl[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "C \<in>\<^sub>\<circ> Vset \<alpha>"
	shows
	"M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>"
	proof-
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms have lhs:
	"M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C :
	A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1)
	cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C)\<lparr>ArrVal\<rparr>) =
	A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms Set.category_axioms have rhs:
	"cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr> :
	A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>)\<lparr>ArrVal\<rparr>) = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs:
	"arr_Set \<alpha> (M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C)"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C)\<lparr>ArrVal\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a_bc assume prems: "a_bc \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	then obtain a b c
	where a_bc_def: "a_bc = \<langle>a, \<langle>b, c\<rangle>\<rangle>"
	and a: "a \<in>\<^sub>\<circ> A"
	and b: "b \<in>\<^sub>\<circ> B"
	and c: "c \<in>\<^sub>\<circ> C"
	by clarsimp
	from assms prems a b c lhs rhs show
	"(M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C)\<lparr>ArrVal\<rparr>\<lparr>a_bc\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a_bc\<rparr>"
	unfolding a_bc_def
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cat_cs_simps
	cs_intro: V_cs_intros cat_rel_par_Set_cs_intros cat_cs_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed (use lhs rhs in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	qed

	lemma (in \<Z>) M\<alpha>_Rel_arrow_lr_M\<alpha>_Rel_arrow_rl'[cat_cs_simps]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	shows
	"M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)\<rparr>"
	using assms
	unfolding cat_Set_components(1)
	by (rule M\<alpha>_Rel_arrow_lr_M\<alpha>_Rel_arrow_rl)

	lemmas [cat_cs_simps] = \<Z>.M\<alpha>_Rel_arrow_lr_M\<alpha>_Rel_arrow_rl'


	subsubsection\<open>Components for \<open>M\<alpha>\<close> for \<open>Rel\<close> are isomorphisms\<close>

	lemma (in \<Z>)
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "C \<in>\<^sub>\<circ> Vset \<alpha>"
	- shows M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset:
	+ shows M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr_Vset:
	"M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	- and M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset:
	+ and M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr_Vset:
	"M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof-
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have lhs: "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by (intro M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_Vset assms)
	from assms have [cat_cs_simps]:
	"M\<alpha>_Rel_arrow_rl A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_lr A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
	)
	from assms have [cat_cs_simps]:
	"M\<alpha>_Rel_arrow_lr A B C \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> M\<alpha>_Rel_arrow_rl A B C =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A \<times>\<^sub>\<circ> B \<times>\<^sub>\<circ> C\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
	)
	from
	- Set.is_arr_isomorphismI'
	+ Set.is_iso_arrI'
	[
	OF lhs M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_Vset[OF assms],
	unfolded cat_cs_simps,
	simplified
	]
	show "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by auto
	qed

	lemma (in \<Z>)
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	- shows M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism:
	+ shows M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr:
	"M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	- and M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism:
	+ and M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr:
	"M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	using assms
	unfolding cat_Set_components(1)
	by
	(
	all
	\<open>
	intro
	- M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset
	- M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset
	+ M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr_Vset
	+ M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr_Vset
	\<close>
	)

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
	+ M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Set \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr)

	lemmas [cat_rel_par_Set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr'

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
	+ M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr'[cat_rel_par_Set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Set \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr)

	lemmas [cat_rel_par_Set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr'

	lemma (in \<Z>)
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	- shows M\<alpha>_Rel_arrow_lr_is_cat_Par_arr_isomorphism:
	+ shows M\<alpha>_Rel_arrow_lr_is_cat_Par_iso_arr:
	"M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	- and M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism:
	+ and M\<alpha>_Rel_arrow_rl_is_cat_Par_iso_arr:
	"M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	show "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by
	(
	- rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Par.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
	+ OF M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Par_components]
	]
	]
	)
	show "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by
	(
	- rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Par.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
	+ OF M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Par_components]
	]
	]
	)
	qed

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_lr_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
	+ M\<alpha>_Rel_arrow_lr_is_cat_Par_iso_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Par \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_lr_is_cat_Par_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_lr_is_cat_Par_iso_arr)

	lemmas [cat_rel_Par_set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Par_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Par_iso_arr'

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
	+ M\<alpha>_Rel_arrow_rl_is_cat_Par_iso_arr'[cat_rel_Par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Par \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Par \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_rl_is_cat_Par_iso_arr)

	lemmas [cat_rel_Par_set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Par_iso_arr'

	lemma (in \<Z>)
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	- shows M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr_isomorphism:
	+ shows M\<alpha>_Rel_arrow_lr_is_cat_Rel_iso_arr:
	"M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	- and M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism:
	+ and M\<alpha>_Rel_arrow_rl_is_cat_Rel_iso_arr:
	"M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	proof-
	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule wr_subcat_trans
	[
	OF
	Set_Par.wide_replete_subcategory_axioms
	Par_Rel.wide_replete_subcategory_axioms
	]
	)
	show "M\<alpha>_Rel_arrow_lr A B C : (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	by
	(
	- rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Rel.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
	+ OF M\<alpha>_Rel_arrow_lr_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Rel_components]
	]
	]
	)
	show "M\<alpha>_Rel_arrow_rl A B C : A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	by
	(
	- rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ rule Set_Rel.wr_subcat_is_iso_arr_is_iso_arr
	[
	THEN iffD1,
	- OF M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
	+ OF M\<alpha>_Rel_arrow_rl_is_cat_Set_iso_arr_Vset[
	OF assms[unfolded cat_Rel_components]
	]
	]
	)
	qed

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
	+ M\<alpha>_Rel_arrow_lr_is_cat_Rel_iso_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "A' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "B' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "M\<alpha>_Rel_arrow_lr A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_lr_is_cat_Rel_iso_arr)

	lemmas [cat_Rel_par_set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Rel_iso_arr'

	lemma (in \<Z>)
	- M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
	+ M\<alpha>_Rel_arrow_rl_is_cat_Rel_iso_arr'[cat_Rel_par_set_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "A' = A \<times>\<^sub>\<circ> (B \<times>\<^sub>\<circ> C)"
	and "B' = (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C"
	and "\<CC>' = cat_Rel \<alpha>"
	shows "M\<alpha>_Rel_arrow_rl A B C : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	using assms(1-3)
	unfolding assms(4-6)
	- by (rule M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism)
	+ by (rule M\<alpha>_Rel_arrow_rl_is_cat_Rel_iso_arr)

	lemmas [cat_Rel_par_set_cs_intros] =
	- \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'
	+ \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Rel_iso_arr'



	subsection\<open>\<open>M\<alpha>\<close> for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition M\<alpha>_Rel :: "V \<Rightarrow> V"
	where "M\<alpha>_Rel \<CC> =
	[
	(\<lambda>abc\<in>\<^sub>\<circ>(\<CC>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>. M\<alpha>_Rel_arrow_lr (abc\<lparr>0\<rparr>) (abc\<lparr>1\<^sub>\<nat>\<rparr>) (abc\<lparr>2\<^sub>\<nat>\<rparr>)),
	cf_blcomp (cf_prod_2_Rel \<CC>),
	cf_brcomp (cf_prod_2_Rel \<CC>),
	\<CC>^\<^sub>C\<^sub>3,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma M\<alpha>_Rel_components:
	shows "M\<alpha>_Rel \<CC>\<lparr>NTMap\<rparr> =
	(\<lambda>abc\<in>\<^sub>\<circ>(\<CC>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>. M\<alpha>_Rel_arrow_lr (abc\<lparr>0\<rparr>) (abc\<lparr>1\<^sub>\<nat>\<rparr>) (abc\<lparr>2\<^sub>\<nat>\<rparr>))"
	and [cat_cs_simps]: "M\<alpha>_Rel \<CC>\<lparr>NTDom\<rparr> = cf_blcomp (cf_prod_2_Rel \<CC>)"
	and [cat_cs_simps]: "M\<alpha>_Rel \<CC>\<lparr>NTCod\<rparr> = cf_brcomp (cf_prod_2_Rel \<CC>)"
	and [cat_cs_simps]: "M\<alpha>_Rel \<CC>\<lparr>NTDGDom\<rparr> = \<CC>^\<^sub>C\<^sub>3"
	and [cat_cs_simps]: "M\<alpha>_Rel \<CC>\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding M\<alpha>_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda M\<alpha>_Rel_components(1)
	\|vsv M\<alpha>_Rel_NTMap_vsv[cat_cs_intros]\|
	\|vdomain M\<alpha>_Rel_NTMap_vdomain[cat_cs_simps]\|
	\|app M\<alpha>_Rel_NTMap_app'\|

	lemma M\<alpha>_Rel_NTMap_app[cat_cs_simps]:
	assumes "ABC = [A, B, C]\<^sub>\<circ>" and "ABC \<in>\<^sub>\<circ> (\<CC>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>"
	shows "M\<alpha>_Rel \<CC>\<lparr>NTMap\<rparr>\<lparr>ABC\<rparr> = M\<alpha>_Rel_arrow_lr A B C"
	using assms(2)
	unfolding assms(1)
	by (simp add: M\<alpha>_Rel_NTMap_app' nat_omega_simps)


	subsubsection\<open>\<open>M\<alpha>\<close> for \<open>Rel\<close> is a natural isomorphism\<close>

	lemma (in \<Z>) M\<alpha>_Rel_is_iso_ntcf:
	"M\<alpha>_Rel (cat_Rel \<alpha>) :
	cf_blcomp (cf_prod_2_Rel (cat_Rel \<alpha>)) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	cf_brcomp (cf_prod_2_Rel (cat_Rel \<alpha>)) :
	cat_Rel \<alpha>^\<^sub>C\<^sub>3 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof-

	interpret cf_prod: is_functor
	\<alpha> \<open>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<close> \<open>cat_Rel \<alpha>\<close> \<open>cf_prod_2_Rel (cat_Rel \<alpha>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Rel_cs_intros)

	show ?thesis
	proof(intro is_iso_ntcfI is_ntcfI')

	show "vfsequence (M\<alpha>_Rel (cat_Rel \<alpha>))" unfolding M\<alpha>_Rel_def by auto
	show "vcard (M\<alpha>_Rel (cat_Rel \<alpha>)) = 5\<^sub>\<nat>"
	unfolding M\<alpha>_Rel_def by (simp add: nat_omega_simps)

	show "M\<alpha>_Rel (cat_Rel \<alpha>)\<lparr>NTMap\<rparr>\<lparr>ABC\<rparr> :
	cf_blcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ObjMap\<rparr>\<lparr>ABC\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub>
	cf_brcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ObjMap\<rparr>\<lparr>ABC\<rparr>"
	if "ABC \<in>\<^sub>\<circ> (cat_Rel \<alpha>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>" for ABC
	proof-
	from that category_cat_Rel obtain A B C
	where ABC_def: "ABC = [A, B, C]\<^sub>\<circ>"
	and A: "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and C: "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	by (elim cat_prod_3_ObjE[rotated 3])
	from that A B C show ?thesis
	unfolding ABC_def
	by
	(
	cs_concl cs_shallow
	cs_intro:
	cat_cs_intros cat_Rel_par_set_cs_intros cat_prod_cs_intros
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	)
	qed
	then show "M\<alpha>_Rel (cat_Rel \<alpha>)\<lparr>NTMap\<rparr>\<lparr>ABC\<rparr> :
	cf_blcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ObjMap\<rparr>\<lparr>ABC\<rparr> \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub>
	cf_brcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ObjMap\<rparr>\<lparr>ABC\<rparr>"
	if "ABC \<in>\<^sub>\<circ> (cat_Rel \<alpha>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>" for ABC
	- using that by (simp add: cat_Rel_is_arr_isomorphismD(1))
	+ using that by (simp add: cat_Rel_is_iso_arrD(1))
	show
	"M\<alpha>_Rel (cat_Rel \<alpha>)\<lparr>NTMap\<rparr>\<lparr>ABC'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	cf_blcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ArrMap\<rparr>\<lparr>HGF\<rparr> =
	cf_brcomp (cf_prod_2_Rel (cat_Rel \<alpha>))\<lparr>ArrMap\<rparr>\<lparr>HGF\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	M\<alpha>_Rel (cat_Rel \<alpha>)\<lparr>NTMap\<rparr>\<lparr>ABC\<rparr>"
	if "HGF : ABC \<mapsto>\<^bsub>cat_Rel \<alpha>^\<^sub>C\<^sub>3\<^esub> ABC'" for ABC ABC' HGF
	proof-

	from that obtain H G F A B C A' B' C'
	where HGF_def: "HGF = [H, G, F]\<^sub>\<circ>"
	and ABC_def: "ABC = [A, B, C]\<^sub>\<circ>"
	and ABC'_def: "ABC' = [A', B', C']\<^sub>\<circ>"
	and H_is_arr: "H : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A'"
	and G_is_arr: "G : B \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'"
	and F_is_arr: "F : C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> C'"
	by
	(
	elim cat_prod_3_is_arrE[
	OF category_cat_Rel category_cat_Rel category_cat_Rel
	]
	)

	note H = cat_Rel_is_arrD[OF H_is_arr]
	note G = cat_Rel_is_arrD[OF G_is_arr]
	note F = cat_Rel_is_arrD[OF F_is_arr]

	interpret H: arr_Rel \<alpha> H
	rewrites "H\<lparr>ArrDom\<rparr> = A" and "H\<lparr>ArrCod\<rparr> = A'"
	by (intro H)+
	interpret G: arr_Rel \<alpha> G
	rewrites "G\<lparr>ArrDom\<rparr> = B" and "G\<lparr>ArrCod\<rparr> = B'"
	by (intro G)+
	interpret F: arr_Rel \<alpha> F
	rewrites "F\<lparr>ArrDom\<rparr> = C" and "F\<lparr>ArrCod\<rparr> = C'"
	by (intro F)+

	let ?ABC' = \<open>M\<alpha>_Rel_arrow_lr A' B' C'\<close>
	and ?ABC = \<open>M\<alpha>_Rel_arrow_lr A B C\<close>
	and ?HG_F =
	\<open>
	prod_2_Rel_ArrVal
	(prod_2_Rel_ArrVal (H\<lparr>ArrVal\<rparr>) (G\<lparr>ArrVal\<rparr>))
	(F\<lparr>ArrVal\<rparr>)
	\<close>
	and ?H_GF =
	\<open>
	prod_2_Rel_ArrVal
	(H\<lparr>ArrVal\<rparr>)
	(prod_2_Rel_ArrVal (G\<lparr>ArrVal\<rparr>) (F\<lparr>ArrVal\<rparr>))
	\<close>

	have [cat_cs_simps]:
	- "?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel (prod_2_Rel H G) F =
	- prod_2_Rel H (prod_2_Rel G F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC"
	+ "?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F =
	+ H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC"
	proof-

	from H_is_arr G_is_arr F_is_arr have lhs:
	- "?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel (prod_2_Rel H G) F :
	+ "?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F :
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A' \<times>\<^sub>\<circ> (B' \<times>\<^sub>\<circ> C')"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros
	)
	from H_is_arr G_is_arr F_is_arr have rhs:
	- "prod_2_Rel H (prod_2_Rel G F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC :
	+ "H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC :
	(A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A' \<times>\<^sub>\<circ> (B' \<times>\<^sub>\<circ> C')"
	by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule arr_Rel_eqI)

	from lhs show arr_Rel_lhs:
	- "arr_Rel \<alpha> (?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel (prod_2_Rel H G) F)"
	+ "arr_Rel \<alpha> (?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F)"
	by (auto dest: cat_Rel_is_arrD)
	from rhs show arr_Rel_rhs:
	- "arr_Rel \<alpha> (prod_2_Rel H (prod_2_Rel G F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC)"
	+ "arr_Rel \<alpha> (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC)"
	by (auto dest: cat_Rel_is_arrD)

	have [cat_cs_simps]: "?ABC'\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?HG_F = ?H_GF \<circ>\<^sub>\<circ> ?ABC\<lparr>ArrVal\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	fix abc_abc'' assume prems: "abc_abc'' \<in>\<^sub>\<circ> ?ABC'\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?HG_F"
	then obtain abc abc' abc''
	where abc_abc''_def: "abc_abc'' = \<langle>abc, abc''\<rangle>"
	and abc_abc': "\<langle>abc, abc'\<rangle> \<in>\<^sub>\<circ> ?HG_F"
	and abc'_abc'': "\<langle>abc', abc''\<rangle> \<in>\<^sub>\<circ> ?ABC'\<lparr>ArrVal\<rparr>"
	- by clarsimp
	+ by (elim vcompE)
	from abc_abc' obtain ab c ab' c'
	where abc_abc'_def: "\<langle>abc, abc'\<rangle> = \<langle>\<langle>ab, c\<rangle>, \<langle>ab', c'\<rangle>\<rangle>"
	and ab_ab':
	"\<langle>ab, ab'\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (H\<lparr>ArrVal\<rparr>) (G\<lparr>ArrVal\<rparr>)"
	and cc': "\<langle>c, c'\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	- by auto
	+ by (meson prod_2_Rel_ArrValE)
	then have abc_def: "abc = \<langle>ab, c\<rangle>" and abc'_def: "abc' = \<langle>ab', c'\<rangle>"
	by auto
	from ab_ab' obtain a b a' b'
	where ab_ab'_def: "\<langle>ab, ab'\<rangle> = \<langle>\<langle>a, b\<rangle>, \<langle>a', b'\<rangle>\<rangle>"
	and aa': "\<langle>a, a'\<rangle> \<in>\<^sub>\<circ> H\<lparr>ArrVal\<rparr>"
	and bb': "\<langle>b, b'\<rangle> \<in>\<^sub>\<circ> G\<lparr>ArrVal\<rparr>"
	by auto
	then have ab_def: "ab = \<langle>a, b\<rangle>" and ab'_def: "ab' = \<langle>a', b'\<rangle>"
	by auto
	from cc' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange
	have c: "c \<in>\<^sub>\<circ> C" and c': "c' \<in>\<^sub>\<circ> C'"
	by auto
	from bb' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange
	have b: "b \<in>\<^sub>\<circ> B" and b': "b' \<in>\<^sub>\<circ> B'"
	by auto
	from aa' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange
	have a: "a \<in>\<^sub>\<circ> A" and a': "a' \<in>\<^sub>\<circ> A'"
	by auto
	from abc'_abc'' have "abc'' = ?ABC'\<lparr>ArrVal\<rparr>\<lparr>abc'\<rparr>"
	by (simp add: vsv.vsv_appI[OF M\<alpha>_Rel_arrow_lr_ArrVal_vsv])
	also from a' b' c' have "\<dots> = \<langle>a', \<langle>b', c'\<rangle>\<rangle>"
	unfolding abc'_def ab'_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	finally have abc''_def: "abc'' = \<langle>a', \<langle>b', c'\<rangle>\<rangle>" by auto
	from aa' bb' cc' a a' b b' c c' show
	"abc_abc'' \<in>\<^sub>\<circ> ?H_GF \<circ>\<^sub>\<circ> ?ABC\<lparr>ArrVal\<rparr>"
	unfolding abc_abc''_def abc_def abc'_def abc''_def ab'_def ab_def
	by (intro vcompI prod_2_Rel_ArrValI)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro:
	vsv.vsv_ex1_app2[THEN iffD1]
	V_cs_intros
	cat_cs_intros
	cat_Rel_cs_intros
	)+
	next
	fix abc_abc'' assume prems: "abc_abc'' \<in>\<^sub>\<circ> ?H_GF \<circ>\<^sub>\<circ> ?ABC\<lparr>ArrVal\<rparr>"
	then obtain abc abc' abc''
	where abc_abc''_def: "abc_abc'' = \<langle>abc, abc''\<rangle>"
	and abc_abc': "\<langle>abc, abc'\<rangle> \<in>\<^sub>\<circ> ?ABC\<lparr>ArrVal\<rparr>"
	and abc'_abc'': "\<langle>abc', abc''\<rangle> \<in>\<^sub>\<circ> ?H_GF"
	- by clarsimp
	+ by (elim vcompE)
	from abc'_abc'' obtain a' bc' a'' bc''
	where abc'_abc''_def: "\<langle>abc', abc''\<rangle> = \<langle>\<langle>a', bc'\<rangle>, \<langle>a'', bc''\<rangle>\<rangle>"
	and aa'': "\<langle>a', a''\<rangle> \<in>\<^sub>\<circ> H\<lparr>ArrVal\<rparr>"
	and bc'_bc'':
	"\<langle>bc', bc''\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (G\<lparr>ArrVal\<rparr>) (F\<lparr>ArrVal\<rparr>)"
	- by auto
	+ by (meson prod_2_Rel_ArrValE)
	then have abc'_def: "abc' = \<langle>a', bc'\<rangle>"
	and abc''_def: "abc'' = \<langle>a'', bc''\<rangle>"
	by auto
	from bc'_bc'' obtain b' c' b'' c''
	where bc'_bc''_def: "\<langle>bc', bc''\<rangle> = \<langle>\<langle>b', c'\<rangle>, \<langle>b'', c''\<rangle>\<rangle>"
	and bb'': "\<langle>b', b''\<rangle> \<in>\<^sub>\<circ> G\<lparr>ArrVal\<rparr>"
	and cc'': "\<langle>c', c''\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	by auto
	then have bc'_def: "bc' = \<langle>b', c'\<rangle>"
	and bc''_def: "bc'' = \<langle>b'', c''\<rangle>"
	by auto
	from cc'' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange
	have c': "c' \<in>\<^sub>\<circ> C" and c'': "c'' \<in>\<^sub>\<circ> C'"
	by auto
	from bb'' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange
	have b': "b' \<in>\<^sub>\<circ> B" and b'': "b'' \<in>\<^sub>\<circ> B'"
	by auto
	from aa'' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange
	have a': "a' \<in>\<^sub>\<circ> A" and a'': "a'' \<in>\<^sub>\<circ> A'"
	by auto
	from abc_abc' have "abc \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (?ABC\<lparr>ArrVal\<rparr>)" by auto
	then have "abc \<in>\<^sub>\<circ> (A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C" by (simp add: cat_cs_simps)
	then obtain a b c
	where abc_def: "abc = \<langle>\<langle>a, b\<rangle>, c\<rangle>"
	and a: "a \<in>\<^sub>\<circ> A"
	and b: "b \<in>\<^sub>\<circ> B"
	and c: "c \<in>\<^sub>\<circ> C"
	by auto
	from abc_abc' have "abc' = ?ABC\<lparr>ArrVal\<rparr>\<lparr>abc\<rparr>"
	by (simp add: vsv.vsv_appI[OF M\<alpha>_Rel_arrow_lr_ArrVal_vsv])
	also from a b c have "\<dots> = \<langle>a, \<langle>b, c\<rangle>\<rangle>"
	unfolding abc_def bc'_def
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: V_cs_intros)
	finally have abc'_def': "abc' = \<langle>a, \<langle>b, c\<rangle>\<rangle>" by auto
	with abc'_def[unfolded bc'_def] have [cat_cs_simps]:
	"a = a'" "b = b'" "c = c'"
	by auto
	from a'' b'' c'' have "\<langle>\<langle>a'', b''\<rangle>, c''\<rangle> \<in>\<^sub>\<circ> (A' \<times>\<^sub>\<circ> B') \<times>\<^sub>\<circ> C'"
	by (cs_concl cs_shallow cs_intro: V_cs_intros)
	with aa'' bb'' cc'' a a' b b' c c' show
	"abc_abc'' \<in>\<^sub>\<circ> ?ABC'\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?HG_F"
	unfolding abc_abc''_def abc_def abc'_def abc''_def bc''_def
	by (intro vcompI prod_2_Rel_ArrValI)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro:
	vsv.vsv_ex1_app2[THEN iffD1]
	V_cs_intros cat_cs_intros cat_Rel_cs_intros
	)+
	qed

	from that H_is_arr G_is_arr F_is_arr show
	- "(?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> prod_2_Rel (prod_2_Rel H G) F)\<lparr>ArrVal\<rparr> =
	- (prod_2_Rel H (prod_2_Rel G F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC)\<lparr>ArrVal\<rparr>"
	+ "(?ABC' \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l G) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F)\<lparr>ArrVal\<rparr> =
	+ (H \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (G \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC)\<lparr>ArrVal\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	prod_2_Rel_components comp_Rel_components
	cat_Rel_cs_simps cat_cs_simps
	cs_intro:
	cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
	)

	qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+

	qed

	from that H_is_arr G_is_arr F_is_arr show ?thesis
	unfolding HGF_def ABC_def ABC'_def
	by
	(
	cs_concl
	cs_intro:
	cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
	cs_simp: cat_Rel_cs_simps cat_cs_simps
	)

	qed

	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma (in \<Z>) M\<alpha>_Rel_is_iso_ntcf'[cat_cs_intros]:
	assumes "\<FF>' = cf_blcomp (cf_prod_2_Rel (cat_Rel \<alpha>))"
	and "\<GG>' = cf_brcomp (cf_prod_2_Rel (cat_Rel \<alpha>))"
	and "\<AA>' = cat_Rel \<alpha>^\<^sub>C\<^sub>3"
	and "\<BB>' = cat_Rel \<alpha>"
	and "\<alpha>' = \<alpha>"
	shows "M\<alpha>_Rel (cat_Rel \<alpha>) : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule M\<alpha>_Rel_is_iso_ntcf)

	lemmas [cat_cs_intros] = \<Z>.M\<alpha>_Rel_is_iso_ntcf'



	subsection\<open>\<open>Ml\<close> and \<open>Mr\<close> for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition Ml_Rel :: "V \<Rightarrow> V \<Rightarrow> V"
	where "Ml_Rel \<CC> a =
	[
	(\<lambda>B\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. vsnd_arrow (set {a}) B),
	cf_prod_2_Rel \<CC>\<^bsub>\<CC>,\<CC>\<^esub>(set {a},-)\<^sub>C\<^sub>F,
	cf_id \<CC>,
	\<CC>,
	\<CC>
	]\<^sub>\<circ>"

	definition Mr_Rel :: "V \<Rightarrow> V \<Rightarrow> V"
	where "Mr_Rel \<CC> b =
	[
	(\<lambda>A\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. vfst_arrow A (set {b})),
	cf_prod_2_Rel \<CC>\<^bsub>\<CC>,\<CC>\<^esub>(-,set {b})\<^sub>C\<^sub>F,
	cf_id \<CC>,
	\<CC>,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma Ml_Rel_components:
	shows "Ml_Rel \<CC> a\<lparr>NTMap\<rparr> = (\<lambda>B\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. vsnd_arrow (set {a}) B)"
	and [cat_cs_simps]: "Ml_Rel \<CC> a\<lparr>NTDom\<rparr> = cf_prod_2_Rel \<CC>\<^bsub>\<CC>,\<CC>\<^esub>(set {a},-)\<^sub>C\<^sub>F"
	and [cat_cs_simps]: "Ml_Rel \<CC> a\<lparr>NTCod\<rparr> = cf_id \<CC>"
	and [cat_cs_simps]: "Ml_Rel \<CC> a\<lparr>NTDGDom\<rparr> = \<CC>"
	and [cat_cs_simps]: "Ml_Rel \<CC> a\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding Ml_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)

	lemma Mr_Rel_components:
	shows "Mr_Rel \<CC> b\<lparr>NTMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. vfst_arrow A (set {b}))"
	and [cat_cs_simps]: "Mr_Rel \<CC> b\<lparr>NTDom\<rparr> = cf_prod_2_Rel \<CC>\<^bsub>\<CC>,\<CC>\<^esub>(-,set {b})\<^sub>C\<^sub>F"
	and [cat_cs_simps]: "Mr_Rel \<CC> b\<lparr>NTCod\<rparr> = cf_id \<CC>"
	and [cat_cs_simps]: "Mr_Rel \<CC> b\<lparr>NTDGDom\<rparr> = \<CC>"
	and [cat_cs_simps]: "Mr_Rel \<CC> b\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding Mr_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda Ml_Rel_components(1)
	\|vsv Ml_Rel_components_NTMap_vsv[cat_cs_intros]\|
	\|vdomain Ml_Rel_components_NTMap_vdomain[cat_cs_simps]\|
	\|app Ml_Rel_components_NTMap_app[cat_cs_simps]\|

	mk_VLambda Mr_Rel_components(1)
	\|vsv Mr_Rel_components_NTMap_vsv[cat_cs_intros]\|
	\|vdomain Mr_Rel_components_NTMap_vdomain[cat_cs_simps]\|
	\|app Mr_Rel_components_NTMap_app[cat_cs_simps]\|


	subsubsection\<open>\<open>Ml\<close> and \<open>Mr\<close> for \<open>Rel\<close> are natural isomorphisms\<close>

	lemma (in \<Z>) Ml_Rel_is_iso_ntcf:
	assumes "a \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "Ml_Rel (cat_Rel \<alpha>) a:
	cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub>(set {a},-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	cf_id (cat_Rel \<alpha>) :
	cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof-

	let ?cf_prod = \<open>cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub> (set {a},-)\<^sub>C\<^sub>F\<close>
	note [cat_cs_simps] = set_empty

	interpret cf_prod: is_functor
	\<alpha> \<open>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<close> \<open>cat_Rel \<alpha>\<close> \<open>cf_prod_2_Rel (cat_Rel \<alpha>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Rel_cs_intros)

	show ?thesis
	proof(intro is_iso_ntcfI is_ntcfI')
	show "vfsequence (Ml_Rel (cat_Rel \<alpha>) a)" unfolding Ml_Rel_def by auto
	show "vcard (Ml_Rel (cat_Rel \<alpha>) a) = 5\<^sub>\<nat>"
	unfolding Ml_Rel_def by (simp add: nat_omega_simps)
	from assms show "?cf_prod : cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_cs_intros V_cs_intros
	)
	show "Ml_Rel (cat_Rel \<alpha>) a\<lparr>NTMap\<rparr>\<lparr>B\<rparr> :
	?cf_prod\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> cf_id (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for B
	using assms that
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps
	cs_intro:
	cat_Rel_par_set_cs_intros
	cat_cs_intros
	V_cs_intros
	cat_prod_cs_intros
	)
	- with cat_Rel_is_arr_isomorphismD[OF this] show
	+ with cat_Rel_is_iso_arrD[OF this] show
	"Ml_Rel (cat_Rel \<alpha>) a\<lparr>NTMap\<rparr>\<lparr>B\<rparr> :
	?cf_prod\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> cf_id (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for B
	using that by simp
	show
	"Ml_Rel (cat_Rel \<alpha>) a\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?cf_prod\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	cf_id (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> Ml_Rel (cat_Rel \<alpha>) a\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "F : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" for A B F
	proof-
	note F = cat_Rel_is_arrD[OF that]
	interpret F: arr_Rel \<alpha> F
	rewrites "F\<lparr>ArrDom\<rparr> = A" and "F\<lparr>ArrCod\<rparr> = B"
	by (intro F)+
	have [cat_cs_simps]:
	"vsnd_arrow (set {a}) B \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	- prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>set {a}\<rparr>) F =
	+ (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>set {a}\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l F =
	F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> vsnd_arrow (set {a}) A"
	(is \<open>?B2 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?aF = F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A2\<close>)
	proof-
	from assms that have lhs:
	"?B2 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?aF : set {a} \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
	)
	from assms that have rhs:
	"F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A2 : set {a} \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
	)
	have [cat_cs_simps]:
	"?B2\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (vid_on (set {a})) (F\<lparr>ArrVal\<rparr>) =
	F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A2\<lparr>ArrVal\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	fix xx'_z assume "xx'_z \<in>\<^sub>\<circ>
	?B2\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (vid_on (set {a})) (F\<lparr>ArrVal\<rparr>)"
	then obtain xx' yy' z
	where xx'_z_def: "xx'_z = \<langle>xx', z\<rangle>"
	and xx'_yy':
	"\<langle>xx', yy'\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (vid_on (set {a})) (F\<lparr>ArrVal\<rparr>)"
	and yy'_z: "\<langle>yy', z\<rangle> \<in>\<^sub>\<circ> ?B2\<lparr>ArrVal\<rparr>"
	- by auto
	+ by (meson vcompE prod_2_Rel_ArrValE)
	from xx'_yy' obtain x x' y y'
	where "\<langle>xx', yy'\<rangle> = \<langle>\<langle>x, x'\<rangle>, \<langle>y, y'\<rangle>\<rangle>"
	and "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> vid_on (set {a})"
	and xy': "\<langle>x', y'\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	by auto
	then have xx'_def: "xx' = \<langle>a, x'\<rangle>" and yy'_def: "yy' = \<langle>a, y'\<rangle>"
	by simp_all
	with yy'_z have y': "y' \<in>\<^sub>\<circ> B" and z_def: "z = y'"
	unfolding vsnd_arrow_components by auto
	from xy' vsubsetD have x': "x' \<in>\<^sub>\<circ> A"
	by (auto intro: F.arr_Rel_ArrVal_vdomain)
	show "xx'_z \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A2\<lparr>ArrVal\<rparr>"
	unfolding xx'_z_def z_def xx'_def
	by (intro vcompI, rule xy')
	(auto simp: vsnd_arrow_components x' VLambda_iff2)
	next
	fix ay_z assume "ay_z \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A2\<lparr>ArrVal\<rparr>"
	then obtain ay y z
	where xx'_z_def: "ay_z = \<langle>ay, z\<rangle>"
	and ay_y: "\<langle>ay, y\<rangle> \<in>\<^sub>\<circ> ?A2\<lparr>ArrVal\<rparr>"
	and yz[cat_cs_intros]: "\<langle>y, z\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	by auto
	then have ay_z_def: "ay_z = \<langle>\<langle>a, y\<rangle>, z\<rangle>"
	and y: "y \<in>\<^sub>\<circ> A"
	and ay_def: "ay = \<langle>a, y\<rangle>"
	unfolding vsnd_arrow_components by auto
	from yz vsubsetD have z: "z \<in>\<^sub>\<circ> B"
	by (auto intro: F.arr_Rel_ArrVal_vrange)
	have [cat_cs_intros]: "\<langle>a, a\<rangle> \<in>\<^sub>\<circ> vid_on (set {a})" by auto
	show "ay_z \<in>\<^sub>\<circ>
	?B2\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (vid_on (set {a})) (F\<lparr>ArrVal\<rparr>)"
	unfolding ay_z_def
	by
	(
	intro vcompI prod_2_Rel_ArrValI,
	rule vsv.vsv_ex1_app1[THEN iffD1],
	unfold cat_cs_simps,
	insert z
	)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	)
	qed
	show ?thesis
	proof(rule arr_Rel_eqI)
	from lhs show arr_Rel_lhs: "arr_Rel \<alpha> (?B2 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?aF)"
	by (auto dest: cat_Rel_is_arrD)
	from rhs show "arr_Rel \<alpha> (F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A2)"
	by (auto dest: cat_Rel_is_arrD)
	note cat_Rel_CId_app[cat_Rel_cs_simps del]
	note \<Z>.cat_Rel_CId_app[cat_Rel_cs_simps del]
	from that assms show
	"(?B2 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?aF)\<lparr>ArrVal\<rparr> = (F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A2)\<lparr>ArrVal\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
	cs_simp:
	id_Rel_components
	cat_Rel_CId_app
	comp_Rel_components(1)
	prod_2_Rel_components
	cat_Rel_components(1)
	)
	qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
	qed
	from that assms show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
	cs_simp: cat_Rel_components(1) V_cs_simps
	)
	qed
	qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma (in \<Z>) Ml_Rel_is_iso_ntcf'[cat_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "\<FF>' = cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub>(set {a},-)\<^sub>C\<^sub>F"
	and "\<GG>' = cf_id (cat_Rel \<alpha>)"
	and "\<AA>' = cat_Rel \<alpha>"
	and "\<BB>' = cat_Rel \<alpha>"
	and "\<alpha>' = \<alpha>"
	shows "Ml_Rel (cat_Rel \<alpha>) a : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	using assms(1) unfolding assms(2-6) by (rule Ml_Rel_is_iso_ntcf)

	lemmas [cat_cs_intros] = \<Z>.Ml_Rel_is_iso_ntcf'

	lemma (in \<Z>) Mr_Rel_is_iso_ntcf:
	assumes "b \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "Mr_Rel (cat_Rel \<alpha>) b :
	cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub>(-,set {b})\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	cf_id (cat_Rel \<alpha>) :
	cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	proof-

	let ?cf_prod = \<open>cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub> (-,set {b})\<^sub>C\<^sub>F\<close>
	note [cat_cs_simps] = set_empty

	interpret cf_prod: is_functor
	\<alpha> \<open>cat_Rel \<alpha> \<times>\<^sub>C cat_Rel \<alpha>\<close> \<open>cat_Rel \<alpha>\<close> \<open>cf_prod_2_Rel (cat_Rel \<alpha>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Rel_cs_intros)

	show ?thesis
	proof(intro is_iso_ntcfI is_ntcfI')
	show "vfsequence (Mr_Rel (cat_Rel \<alpha>) b)" unfolding Mr_Rel_def by auto
	show "vcard (Mr_Rel (cat_Rel \<alpha>) b) = 5\<^sub>\<nat>"
	unfolding Mr_Rel_def by (simp add: nat_omega_simps)
	from assms show "?cf_prod : cat_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Rel \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_cs_intros V_cs_intros
	)
	show "Mr_Rel (cat_Rel \<alpha>) b\<lparr>NTMap\<rparr>\<lparr>B\<rparr> :
	?cf_prod\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Rel \<alpha>\<^esub> cf_id (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for B
	using assms that
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros
	cat_Rel_par_set_cs_intros
	V_cs_intros
	cat_prod_cs_intros
	)
	- with cat_Rel_is_arr_isomorphismD[OF this] show
	+ with cat_Rel_is_iso_arrD[OF this] show
	"Mr_Rel (cat_Rel \<alpha>) b\<lparr>NTMap\<rparr>\<lparr>B\<rparr> :
	?cf_prod\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> cf_id (cat_Rel \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	if "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>" for B
	using that by simp
	show
	"Mr_Rel (cat_Rel \<alpha>) b\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?cf_prod\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	cf_id (cat_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> Mr_Rel (cat_Rel \<alpha>) b\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "F : A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B" for A B F
	proof-
	note F = cat_Rel_is_arrD[OF that]
	interpret F: arr_Rel \<alpha> F
	rewrites "F\<lparr>ArrDom\<rparr> = A" and "F\<lparr>ArrCod\<rparr> = B"
	by (intro F)+
	have [cat_cs_simps]:
	"vfst_arrow B (set {b}) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	- prod_2_Rel F (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>set {b}\<rparr>) =
	+ F \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>set {b}\<rparr>) =
	F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> vfst_arrow A (set {b})"
	(is \<open>?B1 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?bF = F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A1\<close>)
	proof-
	from assms that have lhs:
	"?B1 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?bF : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
	)
	from assms that have rhs:
	"F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A1 : A \<times>\<^sub>\<circ> set {b} \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B"
	by
	(
	cs_concl
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
	)
	have [cat_cs_simps]:
	"?B1\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (F\<lparr>ArrVal\<rparr>) (vid_on (set {b})) =
	F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A1\<lparr>ArrVal\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	fix xx'_z assume "xx'_z \<in>\<^sub>\<circ>
	?B1\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (F\<lparr>ArrVal\<rparr>) (vid_on (set {b}))"
	then obtain xx' yy' z
	where xx'_z_def: "xx'_z = \<langle>xx', z\<rangle>"
	and xx'_yy':
	"\<langle>xx', yy'\<rangle> \<in>\<^sub>\<circ> prod_2_Rel_ArrVal (F\<lparr>ArrVal\<rparr>) (vid_on (set {b}))"
	and yy'_z: "\<langle>yy', z\<rangle> \<in>\<^sub>\<circ> ?B1\<lparr>ArrVal\<rparr>"
	- by auto
	+ by (meson vcompE prod_2_Rel_ArrValE)
	from xx'_yy' obtain x x' y y'
	where "\<langle>xx', yy'\<rangle> = \<langle>\<langle>x, x'\<rangle>, \<langle>y, y'\<rangle>\<rangle>"
	and "\<langle>x', y'\<rangle> \<in>\<^sub>\<circ> vid_on (set {b})"
	and xy: "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	by auto
	then have xx'_def: "xx' = \<langle>x, b\<rangle>" and yy'_def: "yy' = \<langle>y, b\<rangle>"
	by simp_all
	with yy'_z have y': "y \<in>\<^sub>\<circ> B" and z_def: "z = y"
	unfolding vfst_arrow_components by auto
	from xy vsubsetD have x: "x \<in>\<^sub>\<circ> A"
	by (auto intro: F.arr_Rel_ArrVal_vdomain)
	show "xx'_z \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A1\<lparr>ArrVal\<rparr>"
	unfolding xx'_z_def z_def xx'_def
	by (intro vcompI, rule xy)
	(auto simp: vfst_arrow_components x VLambda_iff2)
	next
	fix xy_z assume "xy_z \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> ?A1\<lparr>ArrVal\<rparr>"
	then obtain xy y z
	where xx'_z_def: "xy_z = \<langle>xy, z\<rangle>"
	and xy_y: "\<langle>xy, y\<rangle> \<in>\<^sub>\<circ> ?A1\<lparr>ArrVal\<rparr>"
	and yz[cat_cs_intros]: "\<langle>y, z\<rangle> \<in>\<^sub>\<circ> F\<lparr>ArrVal\<rparr>"
	by auto
	then have xy_z_def: "xy_z = \<langle>\<langle>y, b\<rangle>, z\<rangle>"
	and y: "y \<in>\<^sub>\<circ> A"
	and xy_def: "xy = \<langle>y, b\<rangle>"
	unfolding vfst_arrow_components by auto
	from yz vsubsetD have z: "z \<in>\<^sub>\<circ> B"
	by (auto intro: F.arr_Rel_ArrVal_vrange)
	have [cat_cs_intros]: "\<langle>b, b\<rangle> \<in>\<^sub>\<circ> vid_on (set {b})" by auto
	show "xy_z \<in>\<^sub>\<circ>
	?B1\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> prod_2_Rel_ArrVal (F\<lparr>ArrVal\<rparr>) (vid_on (set {b}))"
	unfolding xy_z_def
	by
	(
	intro vcompI prod_2_Rel_ArrValI,
	rule vsv.vsv_ex1_app1[THEN iffD1],
	unfold cat_cs_simps,
	insert z
	)
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	)
	qed
	show ?thesis
	proof(rule arr_Rel_eqI)
	from lhs show arr_Rel_lhs: "arr_Rel \<alpha> (?B1 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?bF)"
	by (auto dest: cat_Rel_is_arrD)
	from rhs show "arr_Rel \<alpha> (F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A1)"
	by (auto dest: cat_Rel_is_arrD)
	note cat_Rel_CId_app[cat_Rel_cs_simps del]
	note \<Z>.cat_Rel_CId_app[cat_Rel_cs_simps del]
	from that assms show
	"(?B1 \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?bF)\<lparr>ArrVal\<rparr> = (F \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?A1)\<lparr>ArrVal\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Rel_cs_simps
	cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
	cs_simp:
	id_Rel_components
	cat_Rel_CId_app
	comp_Rel_components(1)
	prod_2_Rel_components
	cat_Rel_components(1)
	)
	qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
	qed
	from that assms show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
	cs_simp: cat_Rel_components(1) V_cs_simps
	)
	qed
	qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma (in \<Z>) Mr_Rel_is_iso_ntcf'[cat_cs_intros]:
	assumes "b \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and "\<FF>' = cf_prod_2_Rel (cat_Rel \<alpha>)\<^bsub>cat_Rel \<alpha>,cat_Rel \<alpha>\<^esub>(-,set {b})\<^sub>C\<^sub>F"
	and "\<GG>' = cf_id (cat_Rel \<alpha>)"
	and "\<AA>' = cat_Rel \<alpha>"
	and "\<BB>' = cat_Rel \<alpha>"
	and "\<alpha>' = \<alpha>"
	shows "Mr_Rel (cat_Rel \<alpha>) b : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	using assms(1) unfolding assms(2-6) by (rule Mr_Rel_is_iso_ntcf)

	lemmas [cat_cs_intros] = \<Z>.Mr_Rel_is_iso_ntcf'



	subsection\<open>\<open>Rel\<close> as a monoidal category\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	For further information see
	\cite{noauthor_wikipedia_2001}\footnote{\url{
	https://en.wikipedia.org/wiki/Category_of_relations
	}}.
	\<close>

	definition mcat_Rel :: "V \<Rightarrow> V \<Rightarrow> V"
	where "mcat_Rel \<alpha> a =
	[
	cat_Rel \<alpha>,
	cf_prod_2_Rel (cat_Rel \<alpha>),
	set {a},
	M\<alpha>_Rel (cat_Rel \<alpha>),
	Ml_Rel (cat_Rel \<alpha>) a,
	Mr_Rel (cat_Rel \<alpha>) a
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma mcat_Rel_components:
	shows "mcat_Rel \<alpha> a\<lparr>Mcat\<rparr> = cat_Rel \<alpha>"
	and "mcat_Rel \<alpha> a\<lparr>Mcf\<rparr> = cf_prod_2_Rel (cat_Rel \<alpha>)"
	and "mcat_Rel \<alpha> a\<lparr>Me\<rparr> = set {a}"
	and "mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr> = M\<alpha>_Rel (cat_Rel \<alpha>)"
	and "mcat_Rel \<alpha> a\<lparr>Ml\<rparr> = Ml_Rel (cat_Rel \<alpha>) a"
	and "mcat_Rel \<alpha> a\<lparr>Mr\<rparr> = Mr_Rel (cat_Rel \<alpha>) a"
	unfolding mcat_Rel_def mcat_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>\<open>Rel\<close> is a monoidal category\<close>

	lemma (in \<Z>) monoidal_category_mcat_Rel:
	assumes "a \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "monoidal_category \<alpha> (mcat_Rel \<alpha> a)"
	proof-

	interpret Set_Par: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Par \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Set_cat_Par)
	interpret Par_Rel: wide_replete_subcategory \<alpha> \<open>cat_Par \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by (rule wide_replete_subcategory_cat_Par_cat_Rel)
	interpret Set_Rel: wide_replete_subcategory \<alpha> \<open>cat_Set \<alpha>\<close> \<open>cat_Rel \<alpha>\<close>
	by
	(
	rule wr_subcat_trans
	[
	OF
	Set_Par.wide_replete_subcategory_axioms
	Par_Rel.wide_replete_subcategory_axioms
	]
	)

	show ?thesis
	proof(rule monoidal_categoryI)
	show "vfsequence (mcat_Rel \<alpha> a)" unfolding mcat_Rel_def by auto
	show "category \<alpha> (mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>)"
	unfolding mcat_Rel_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "mcat_Rel \<alpha> a\<lparr>Mcf\<rparr> :
	mcat_Rel \<alpha> a\<lparr>Mcat\<rparr> \<times>\<^sub>C mcat_Rel \<alpha> a\<lparr>Mcat\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>"
	unfolding mcat_Rel_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr> :
	cf_blcomp (mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_brcomp (mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>) :
	mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>^\<^sub>C\<^sub>3 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>"
	unfolding mcat_Rel_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "mcat_Rel \<alpha> a\<lparr>Ml\<rparr> :
	mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>,mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub> (mcat_Rel \<alpha> a\<lparr>Me\<rparr>,-)\<^sub>C\<^sub>F
	\<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	cf_id (mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>) :
	mcat_Rel \<alpha> a\<lparr>Mcat\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>"
	unfolding mcat_Rel_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "mcat_Rel \<alpha> a\<lparr>Mr\<rparr> :
	mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>,mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub> (-,mcat_Rel \<alpha> a\<lparr>Me\<rparr>)\<^sub>C\<^sub>F
	\<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	cf_id (mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>) : mcat_Rel \<alpha> a\<lparr>Mcat\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>"
	unfolding mcat_Rel_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "vcard (mcat_Rel \<alpha> a) = 6\<^sub>\<nat>"
	unfolding mcat_Rel_def by (simp add: nat_omega_simps)
	from assms show "mcat_Rel \<alpha> a\<lparr>Me\<rparr> \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	unfolding mcat_Rel_components cat_Rel_components by force
	show
	"mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>B, C, D\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>
	A, B \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub> C, D
	\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub>
	(mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>A, B, C\<rparr>\<^sub>\<bullet> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>D\<rparr>) =
	mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>
	A, B, C \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub> D
	\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>A \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub> B, C, D\<rparr>\<^sub>\<bullet>"
	if "A \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	and "B \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	and "C \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	and "D \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>"
	for A B C D
	proof-

	have [cat_cs_simps]:
	- "prod_2_Rel (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (M\<alpha>_Rel_arrow_lr B C D) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	+ "(cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (M\<alpha>_Rel_arrow_lr B C D) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	(
	M\<alpha>_Rel_arrow_lr A (B \<times>\<^sub>\<circ> C) D \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	- prod_2_Rel (M\<alpha>_Rel_arrow_lr A B C) (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>D\<rparr>)
	+ (M\<alpha>_Rel_arrow_lr A B C) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Rel \<alpha>\<lparr>CId\<rparr>\<lparr>D\<rparr>)
	) =
	M\<alpha>_Rel_arrow_lr A B (C \<times>\<^sub>\<circ> D) \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub>
	M\<alpha>_Rel_arrow_lr (A \<times>\<^sub>\<circ> B) C D"
	(
	is
	\<open>
	?A_BCD \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?ABC_D) =
	?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Rel \<alpha>\<^esub> ?AB_C_D
	\<close>
	)
	proof-

	have [cat_cs_simps]:
	- "prod_2_Rel (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (M\<alpha>_Rel_arrow_lr B C D) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	+ "(cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (M\<alpha>_Rel_arrow_lr B C D) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	(
	?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	- prod_2_Rel (M\<alpha>_Rel_arrow_lr A B C) (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>D\<rparr>)
	+ (M\<alpha>_Rel_arrow_lr A B C) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>D\<rparr>)
	) = ?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D"
	(
	is
	\<open>
	?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D) =
	?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D
	\<close>
	)
	proof-
	from that have lhs:
	"?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D) :
	((A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C) \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> B \<times>\<^sub>\<circ> C \<times>\<^sub>\<circ> D"
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_components(1)
	cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros V_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D))\<lparr>ArrVal\<rparr>) =
	((A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C) \<times>\<^sub>\<circ> D"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from that have rhs: "?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D :
	((A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C) \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> B \<times>\<^sub>\<circ> C \<times>\<^sub>\<circ> D"
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_components(1) cat_Set_components(1)
	cs_intro:
	cat_cs_intros V_cs_intros M\<alpha>_Rel_arrow_lr_is_cat_Set_arr'
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D)\<lparr>ArrVal\<rparr>) =
	((A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C) \<times>\<^sub>\<circ> D"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs:
	"arr_Set \<alpha> (?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D))"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs:
	"arr_Set \<alpha> (?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D))\<lparr>ArrVal\<rparr> =
	(?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix abcd assume prems: "abcd \<in>\<^sub>\<circ> ((A \<times>\<^sub>\<circ> B) \<times>\<^sub>\<circ> C) \<times>\<^sub>\<circ> D"
	then obtain a b c d
	where abcd_def: "abcd = \<langle>\<langle>\<langle>a, b\<rangle>, c\<rangle>, d\<rangle>"
	and a: "a \<in>\<^sub>\<circ> A"
	and b: "b \<in>\<^sub>\<circ> B"
	and c: "c \<in>\<^sub>\<circ> C"
	and d: "d \<in>\<^sub>\<circ> D"
	by clarsimp
	from that prems a b c d show
	"(
	?A_BCD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	(?A_BC_D \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ABC_D)
	)\<lparr>ArrVal\<rparr>\<lparr>abcd\<rparr> =
	(?A_B_CD \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AB_C_D)\<lparr>ArrVal\<rparr>\<lparr>abcd\<rparr>"
	unfolding abcd_def mcat_Rel_components(1) cat_Rel_components(1)
	by (slow)
	(
	cs_concl cs_shallow
	cs_simp:
	cat_Set_components(1)
	cat_cs_simps
	cat_rel_par_Set_cs_simps
	cs_intro:
	cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed (use lhs rhs in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	qed

	from assms that show ?thesis
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_cs_simps
	cat_Rel_components(1)
	cat_Set_components(1)
	Set_Rel.subcat_CId[symmetric]
	Set_Rel.subcat_Comp_simp[symmetric]
	cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
	)+

	qed

	from that show ?thesis
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_components(1) cat_cs_simps
	cs_intro:
	cat_cs_intros
	cat_Rel_par_set_cs_intros
	V_cs_intros
	cat_prod_cs_intros
	)

	qed

	show
	"mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>A\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>Ml\<rparr>\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>M\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>A, mcat_Rel \<alpha> a\<lparr>Me\<rparr>, B\<rparr>\<^sub>\<bullet> =
	mcat_Rel \<alpha> a\<lparr>Mr\<rparr>\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>mcat_Rel \<alpha> a\<lparr>Mcf\<rparr>\<^esub>
	mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>CId\<rparr>\<lparr>B\<rparr>"
	if "A \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> mcat_Rel \<alpha> a\<lparr>Mcat\<rparr>\<lparr>Obj\<rparr>" for A B
	proof-

	note [cat_cs_simps] = set_empty

	have [cat_cs_simps]:
	- "prod_2_Rel (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) (vsnd_arrow (set {a}) B) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	+ "(cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>A\<rparr>) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (vsnd_arrow (set {a}) B) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	M\<alpha>_Rel_arrow_lr A (set {a}) B =
	- prod_2_Rel (vfst_arrow A (set {a})) (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>)"
	+ (vfst_arrow A (set {a})) \<^sub>A\<times>\<^sub>R\<^sub>e\<^sub>l (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>B\<rparr>)"
	(is \<open>?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB = ?Aa_B\<close>)
	proof-
	from assms that have lhs:
	"?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB : (A \<times>\<^sub>\<circ> set {a}) \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> B"
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Rel_components(1) cat_Set_components(1)
	cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB)\<lparr>ArrVal\<rparr>) = (A \<times>\<^sub>\<circ> set {a}) \<times>\<^sub>\<circ> B"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms that have rhs:
	"?Aa_B : (A \<times>\<^sub>\<circ> set {a}) \<times>\<^sub>\<circ> B \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A \<times>\<^sub>\<circ> B"
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Set_components(1)
	cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
	)
	then have dom_rhs: "\<D>\<^sub>\<circ> (?Aa_B\<lparr>ArrVal\<rparr>) = (A \<times>\<^sub>\<circ> set {a}) \<times>\<^sub>\<circ> B"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs: "arr_Set \<alpha> (?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB)"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs: "arr_Set \<alpha> ?Aa_B"
	by (auto dest: cat_Set_is_arrD(1))
	show "(?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB)\<lparr>ArrVal\<rparr> = ?Aa_B\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix xay assume "xay \<in>\<^sub>\<circ> (A \<times>\<^sub>\<circ> set {a}) \<times>\<^sub>\<circ> B"
	then obtain x y
	where xay_def: "xay = \<langle>\<langle>x, a\<rangle>, y\<rangle>" and x: "x \<in>\<^sub>\<circ> A" and y: "y \<in>\<^sub>\<circ> B"
	by auto
	from assms that x y show
	"(?A_aB \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?AaB)\<lparr>ArrVal\<rparr>\<lparr>xay\<rparr> = ?Aa_B\<lparr>ArrVal\<rparr>\<lparr>xay\<rparr>"
	unfolding xay_def mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_Rel_components(1) cat_Set_components(1)
	cat_cs_simps cat_rel_par_Set_cs_simps
	cs_intro:
	cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
	qed

	from assms that show ?thesis
	unfolding mcat_Rel_components cat_Rel_components(1)
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_cs_simps
	cat_Rel_components(1)
	cat_Set_components(1)
	Set_Rel.subcat_CId[symmetric]
	Set_Rel.subcat_Comp_simp[symmetric]
	cs_intro:
	cat_cs_intros
	cat_rel_par_Set_cs_intros
	V_cs_intros
	cat_prod_cs_intros
	Set_Rel.subcat_is_arrD
	)

	qed

	qed auto

	qed



	subsection\<open>Dagger monoidal categories\<close>


	subsubsection\<open>Background\<close>


	text\<open>See \cite{coecke_survey_2010} for further information.\<close>


	named_theorems dmcat_field_simps

	named_theorems dmcat_cs_simps
	named_theorems dmcat_cs_intros

	definition DMcat :: V where [dmcat_field_simps]: "DMcat = 0"
	definition DMdag :: V where [dmcat_field_simps]: "DMdag = 1\<^sub>\<nat>"
	definition DMcf :: V where [dmcat_field_simps]: "DMcf = 2\<^sub>\<nat>"
	definition DMe :: V where [dmcat_field_simps]: "DMe = 3\<^sub>\<nat>"
	definition DM\<alpha> :: V where [dmcat_field_simps]: "DM\<alpha> = 4\<^sub>\<nat>"
	definition DMl :: V where [dmcat_field_simps]: "DMl = 5\<^sub>\<nat>"
	definition DMr :: V where [dmcat_field_simps]: "DMr = 6\<^sub>\<nat>"

	abbreviation DMDag_app :: "V \<Rightarrow> V" (\<open>\<dagger>\<^sub>M\<^sub>C\<close>)
	where "\<dagger>\<^sub>M\<^sub>C \<CC> \<equiv> \<CC>\<lparr>DMdag\<rparr>"


	subsubsection\<open>Slicing\<close>


	text\<open>Dagger category.\<close>

	definition dmcat_dagcat :: "V \<Rightarrow> V"
	where "dmcat_dagcat \<CC> = [\<CC>\<lparr>DMcat\<rparr>, \<CC>\<lparr>DMdag\<rparr>]\<^sub>\<circ>"

	lemma dmcat_dagcat_components[slicing_simps]:
	shows "dmcat_dagcat \<CC>\<lparr>DagCat\<rparr> = \<CC>\<lparr>DMcat\<rparr>"
	and "dmcat_dagcat \<CC>\<lparr>DagDag\<rparr> = \<CC>\<lparr>DMdag\<rparr>"
	unfolding dmcat_dagcat_def dmcat_field_simps dag_field_simps
	by (auto simp: nat_omega_simps)


	text\<open>Monoidal category.\<close>

	definition dmcat_mcat :: "V \<Rightarrow> V"
	where "dmcat_mcat \<CC> = [\<CC>\<lparr>DMcat\<rparr>, \<CC>\<lparr>DMcf\<rparr>, \<CC>\<lparr>DMe\<rparr>, \<CC>\<lparr>DM\<alpha>\<rparr>, \<CC>\<lparr>DMl\<rparr>, \<CC>\<lparr>DMr\<rparr>]\<^sub>\<circ>"

	lemma dmcat_mcat_components[slicing_simps]:
	shows "dmcat_mcat \<CC>\<lparr>Mcat\<rparr> = \<CC>\<lparr>DMcat\<rparr>"
	and "dmcat_mcat \<CC>\<lparr>Mcf\<rparr> = \<CC>\<lparr>DMcf\<rparr>"
	and "dmcat_mcat \<CC>\<lparr>Me\<rparr> = \<CC>\<lparr>DMe\<rparr>"
	and "dmcat_mcat \<CC>\<lparr>M\<alpha>\<rparr> = \<CC>\<lparr>DM\<alpha>\<rparr>"
	and "dmcat_mcat \<CC>\<lparr>Ml\<rparr> = \<CC>\<lparr>DMl\<rparr>"
	and "dmcat_mcat \<CC>\<lparr>Mr\<rparr> = \<CC>\<lparr>DMr\<rparr>"
	unfolding dmcat_mcat_def dmcat_field_simps mcat_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>Definition and elementary properties\<close>

	locale dagger_monoidal_category = \<Z> \<alpha> + vfsequence \<CC> for \<alpha> \<CC> +
	assumes dmcat_length[dmcat_cs_simps]: "vcard \<CC> = 7\<^sub>\<nat>"
	and dmcat_dagger_category: "dagger_category \<alpha> (dmcat_dagcat \<CC>)"
	and dmcat_monoidal_category: "monoidal_category \<alpha> (dmcat_mcat \<CC>)"
	and dmcat_compatibility:
	"\<lbrakk> g : c \<mapsto>\<^bsub>\<CC>\<lparr>DMcat\<rparr>\<^esub> d; f : a \<mapsto>\<^bsub>\<CC>\<lparr>DMcat\<rparr>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>DMcf\<rparr>\<^esub> f\<rparr> =
	\<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<CC>\<lparr>DMcf\<rparr>\<^esub> \<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	and dmcat_M\<alpha>_unital: "A \<in>\<^sub>\<circ> (\<CC>\<lparr>DMcat\<rparr>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr> \<Longrightarrow>
	\<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>DM\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>A\<rparr>\<rparr> = (\<CC>\<lparr>DM\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>A\<rparr>)\<inverse>\<^sub>C\<^bsub>\<CC>\<lparr>DMcat\<rparr>\<^esub>"
	and dmcat_Ml_unital: "a \<in>\<^sub>\<circ> \<CC>\<lparr>DMcat\<rparr>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>DMl\<rparr>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> = (\<CC>\<lparr>DMl\<rparr>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<inverse>\<^sub>C\<^bsub>\<CC>\<lparr>DMcat\<rparr>\<^esub>"
	and dmcat_Mr_unital: "a \<in>\<^sub>\<circ> \<CC>\<lparr>DMcat\<rparr>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<dagger>\<^sub>M\<^sub>C \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>DMr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> = (\<CC>\<lparr>DMr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<inverse>\<^sub>C\<^bsub>\<CC>\<lparr>DMcat\<rparr>\<^esub>"


	text\<open>Rules.\<close>

	lemma (in dagger_monoidal_category)
	dagger_monoidal_category_axioms'[dmcat_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "dagger_monoidal_category \<alpha>' \<CC>"
	unfolding assms by (rule dagger_monoidal_category_axioms)

	mk_ide rf
	dagger_monoidal_category_def[unfolded dagger_monoidal_category_axioms_def]
	\|intro dagger_monoidal_categoryI[intro]\|
	\|dest dagger_monoidal_categoryD[dest]\|
	\|elim dagger_monoidal_categoryE[elim]\|


	text\<open>Elementary properties.\<close>

	lemma dmcat_eqI:
	assumes "dagger_monoidal_category \<alpha> \<AA>"
	and "dagger_monoidal_category \<alpha> \<BB>"
	and "\<AA>\<lparr>DMcat\<rparr> = \<BB>\<lparr>DMcat\<rparr>"
	and "\<AA>\<lparr>DMdag\<rparr> = \<BB>\<lparr>DMdag\<rparr>"
	and "\<AA>\<lparr>DMcf\<rparr> = \<BB>\<lparr>DMcf\<rparr>"
	and "\<AA>\<lparr>DMe\<rparr> = \<BB>\<lparr>DMe\<rparr>"
	and "\<AA>\<lparr>DM\<alpha>\<rparr> = \<BB>\<lparr>DM\<alpha>\<rparr>"
	and "\<AA>\<lparr>DMl\<rparr> = \<BB>\<lparr>DMl\<rparr>"
	and "\<AA>\<lparr>DMr\<rparr> = \<BB>\<lparr>DMr\<rparr>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>: dagger_monoidal_category \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: dagger_monoidal_category \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<AA> = 7\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: dmcat_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>"
	by (cs_concl cs_shallow cs_simp: dmcat_cs_simps V_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<AA> \<Longrightarrow> \<AA>\<lparr>a\<rparr> = \<BB>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms)
	(auto simp: dmcat_field_simps)
	qed auto
	qed


	text\<open>Slicing.\<close>

	context dagger_monoidal_category
	begin

	interpretation dagcat: dagger_category \<alpha> \<open>dmcat_dagcat \<CC>\<close>
	by (rule dmcat_dagger_category)

	sublocale DMCat: category \<alpha> \<open>\<CC>\<lparr>DMcat\<rparr>\<close>
	by (rule dagcat.DagCat.category_axioms[unfolded slicing_simps])

	sublocale DMDag: is_functor \<alpha> \<open>op_cat (\<CC>\<lparr>DMcat\<rparr>)\<close> \<open>\<CC>\<lparr>DMcat\<rparr>\<close> \<open>\<dagger>\<^sub>M\<^sub>C \<CC>\<close>
	by (rule dagcat.DagDag.is_functor_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	dmcat_Dom_vdomain[dmcat_cs_simps] = dagcat.dagcat_ObjMap_identity
	and dmcat_DagCat_idem[dmcat_cs_simps] = dagcat.dagcat_DagCat_idem
	and dmcat_is_functor'[dmcat_cs_intros] = dagcat.dagcat_is_functor'

	end

	lemmas [dmcat_cs_simps] =
	dagger_monoidal_category.dmcat_Dom_vdomain
	dagger_monoidal_category.dmcat_DagCat_idem

	lemmas [dmcat_cs_intros] = dagger_monoidal_category.dmcat_is_functor'

	context dagger_monoidal_category
	begin

	interpretation mcat: monoidal_category \<alpha> \<open>dmcat_mcat \<CC>\<close>
	by (rule dmcat_monoidal_category)

	sublocale DMcf: is_functor \<alpha> \<open>\<CC>\<lparr>DMcat\<rparr> \<times>\<^sub>C \<CC>\<lparr>DMcat\<rparr>\<close> \<open>\<CC>\<lparr>DMcat\<rparr>\<close> \<open>\<CC>\<lparr>DMcf\<rparr>\<close>
	by (rule mcat.Mcf.is_functor_axioms[unfolded slicing_simps])

	sublocale DM\<alpha>: is_iso_ntcf
	\<alpha> \<open>\<CC>\<lparr>DMcat\<rparr>^\<^sub>C\<^sub>3\<close> \<open>\<CC>\<lparr>DMcat\<rparr>\<close> \<open>cf_blcomp (\<CC>\<lparr>DMcf\<rparr>)\<close> \<open>cf_brcomp (\<CC>\<lparr>DMcf\<rparr>)\<close> \<open>\<CC>\<lparr>DM\<alpha>\<rparr>\<close>
	by (rule mcat.M\<alpha>.is_iso_ntcf_axioms[unfolded slicing_simps])

	sublocale DMl: is_iso_ntcf
	\<alpha>
	\<open>\<CC>\<lparr>DMcat\<rparr>\<close>
	\<open>\<CC>\<lparr>DMcat\<rparr>\<close>
	\<open>\<CC>\<lparr>DMcf\<rparr>\<^bsub>\<CC>\<lparr>DMcat\<rparr>,\<CC>\<lparr>DMcat\<rparr>\<^esub>(\<CC>\<lparr>DMe\<rparr>,-)\<^sub>C\<^sub>F\<close>
	\<open>cf_id (\<CC>\<lparr>DMcat\<rparr>)\<close>
	\<open>\<CC>\<lparr>DMl\<rparr>\<close>
	by (rule mcat.Ml.is_iso_ntcf_axioms[unfolded slicing_simps])

	sublocale DMr: is_iso_ntcf
	\<alpha>
	\<open>\<CC>\<lparr>DMcat\<rparr>\<close>
	\<open>\<CC>\<lparr>DMcat\<rparr>\<close>
	\<open>\<CC>\<lparr>DMcf\<rparr>\<^bsub>\<CC>\<lparr>DMcat\<rparr>,\<CC>\<lparr>DMcat\<rparr>\<^esub>(-,\<CC>\<lparr>DMe\<rparr>)\<^sub>C\<^sub>F\<close>
	\<open>cf_id (\<CC>\<lparr>DMcat\<rparr>)\<close>
	\<open>\<CC>\<lparr>DMr\<rparr>\<close>
	by (rule mcat.Mr.is_iso_ntcf_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	dmcat_Me_is_obj[dmcat_cs_intros] = mcat.mcat_Me_is_obj
	and dmcat_pentagon = mcat.mcat_pentagon
	and dmcat_triangle[dmcat_cs_simps] = mcat.mcat_triangle

	end

	lemmas [dmcat_cs_intros] = dagger_monoidal_category.dmcat_Me_is_obj
	lemmas [dmcat_cs_simps] = dagger_monoidal_category.dmcat_triangle



	subsection\<open>\<open>Rel\<close> as a dagger monoidal category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dmcat_Rel :: "V \<Rightarrow> V \<Rightarrow> V"
	where "dmcat_Rel \<alpha> a =
	[
	cat_Rel \<alpha>,
	\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>,
	cf_prod_2_Rel (cat_Rel \<alpha>),
	set {a},
	M\<alpha>_Rel (cat_Rel \<alpha>),
	Ml_Rel (cat_Rel \<alpha>) a,
	Mr_Rel (cat_Rel \<alpha>) a
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dmcat_Rel_components:
	shows "dmcat_Rel \<alpha> a\<lparr>DMcat\<rparr> = cat_Rel \<alpha>"
	and "dmcat_Rel \<alpha> a\<lparr>DMdag\<rparr> = \<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>"
	and "dmcat_Rel \<alpha> a\<lparr>DMcf\<rparr> = cf_prod_2_Rel (cat_Rel \<alpha>)"
	and "dmcat_Rel \<alpha> a\<lparr>DMe\<rparr> = set {a}"
	and "dmcat_Rel \<alpha> a\<lparr>DM\<alpha>\<rparr> = M\<alpha>_Rel (cat_Rel \<alpha>)"
	and "dmcat_Rel \<alpha> a\<lparr>DMl\<rparr> = Ml_Rel (cat_Rel \<alpha>) a"
	and "dmcat_Rel \<alpha> a\<lparr>DMr\<rparr> = Mr_Rel (cat_Rel \<alpha>) a"
	unfolding dmcat_Rel_def dmcat_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma dmcat_dagcat_dmcat_Rel: "dmcat_dagcat (dmcat_Rel \<alpha> a) = dagcat_Rel \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (dmcat_dagcat (dmcat_Rel \<alpha> a)) = 2\<^sub>\<nat>"
	unfolding dmcat_dagcat_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (dagcat_Rel \<alpha>) = 2\<^sub>\<nat>"
	unfolding dagcat_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (dmcat_dagcat (dmcat_Rel \<alpha> a)) = \<D>\<^sub>\<circ> (dagcat_Rel \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "A \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (dmcat_dagcat (dmcat_Rel \<alpha> a)) \<Longrightarrow>
	dmcat_dagcat (dmcat_Rel \<alpha> a)\<lparr>A\<rparr> = dagcat_Rel \<alpha>\<lparr>A\<rparr>"
	for A
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold dmcat_dagcat_def dmcat_field_simps dmcat_Rel_def dagcat_Rel_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: dmcat_dagcat_def dagcat_Rel_def)

	lemma dmcat_mcat_dmcat_Rel: "dmcat_mcat (dmcat_Rel \<alpha> a) = mcat_Rel \<alpha> a"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (dmcat_mcat (dmcat_Rel \<alpha> a)) = 6\<^sub>\<nat>"
	unfolding dmcat_mcat_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (mcat_Rel \<alpha> a) = 6\<^sub>\<nat>"
	unfolding mcat_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (dmcat_mcat (dmcat_Rel \<alpha> a)) = \<D>\<^sub>\<circ> (mcat_Rel \<alpha> a)"
	unfolding dom_lhs dom_rhs by simp
	show "A \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (dmcat_mcat (dmcat_Rel \<alpha> a)) \<Longrightarrow>
	dmcat_mcat (dmcat_Rel \<alpha> a)\<lparr>A\<rparr> = mcat_Rel \<alpha> a\<lparr>A\<rparr>"
	for A
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold dmcat_mcat_def dmcat_field_simps dmcat_Rel_def mcat_Rel_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: dmcat_mcat_def mcat_Rel_def)


	subsubsection\<open>\<open>Rel\<close> is a dagger monoidal category\<close>

	lemma (in \<Z>) dagger_monoidal_category_dmcat_Rel:
	assumes "A \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "dagger_monoidal_category \<alpha> (dmcat_Rel \<alpha> A)"
	proof-
	interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule category_cat_Rel)
	interpret dag_Rel: is_iso_functor \<alpha> \<open>op_cat (cat_Rel \<alpha>)\<close> \<open>cat_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	by (rule cf_dag_Rel_is_iso_functor)
	show ?thesis
	proof(rule dagger_monoidal_categoryI)
	show "\<Z> \<alpha>" by auto
	show "vfsequence (dmcat_Rel \<alpha> A)" unfolding dmcat_Rel_def by simp
	show "vcard (dmcat_Rel \<alpha> A) = 7\<^sub>\<nat>"
	unfolding dmcat_Rel_def by (simp add: nat_omega_simps)
	show "dagger_category \<alpha> (dmcat_dagcat (dmcat_Rel \<alpha> A))"
	unfolding dmcat_dagcat_dmcat_Rel by (rule dagger_category_dagcat_Rel)
	show "monoidal_category \<alpha> (dmcat_mcat (dmcat_Rel \<alpha> A))"
	unfolding dmcat_mcat_dmcat_Rel by (intro monoidal_category_mcat_Rel assms)
	show
	"\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcf\<rparr>\<^esub> f\<rparr> =
	\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcf\<rparr>\<^esub>
	\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : c \<mapsto>\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<^esub> d" and "f : a \<mapsto>\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<^esub> b"
	for c d g a b f
	using that
	unfolding dmcat_Rel_components
	by
	(
	cs_concl cs_shallow
	cs_simp: cf_dag_Rel_ArrMap_app_prod_2_Rel cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	show
	"\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>dmcat_Rel \<alpha> A\<lparr>DM\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>BCD\<rparr>\<rparr> =
	(dmcat_Rel \<alpha> A\<lparr>DM\<alpha>\<rparr>\<lparr>NTMap\<rparr>\<lparr>BCD\<rparr>)\<inverse>\<^sub>C\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<^esub>"
	if "BCD \<in>\<^sub>\<circ> (dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>^\<^sub>C\<^sub>3)\<lparr>Obj\<rparr>" for BCD
	proof-
	from that obtain B C D
	where BCD_def: "BCD = [B, C, D]\<^sub>\<circ>"
	and B: "B \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and C: "C \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	and D: "D \<in>\<^sub>\<circ> cat_Rel \<alpha>\<lparr>Obj\<rparr>"
	unfolding dmcat_Rel_components
	by
	(
	elim cat_prod_3_ObjE
	[
	unfolded dmcat_Rel_components,
	OF Rel.category_axioms Rel.category_axioms Rel.category_axioms
	]
	)
	from B C D show ?thesis
	unfolding dmcat_Rel_components BCD_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps cat_cs_simps
	cs_intro:
	cat_Rel_is_arrD
	cat_cs_intros
	cat_Rel_par_set_cs_intros
	cat_prod_cs_intros
	)
	qed
	show
	"\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>dmcat_Rel \<alpha> A\<lparr>DMl\<rparr>\<lparr>NTMap\<rparr>\<lparr>B\<rparr>\<rparr> =
	(dmcat_Rel \<alpha> A\<lparr>DMl\<rparr>\<lparr>NTMap\<rparr>\<lparr>B\<rparr>)\<inverse>\<^sub>C\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<^esub>"
	if "B \<in>\<^sub>\<circ> dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<lparr>Obj\<rparr>" for B
	using assms that
	unfolding dmcat_Rel_components
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps
	cs_intro: cat_Rel_is_arrD cat_cs_intros cat_arrow_cs_intros
	)+
	show
	"\<dagger>\<^sub>M\<^sub>C (dmcat_Rel \<alpha> A)\<lparr>ArrMap\<rparr>\<lparr>dmcat_Rel \<alpha> A\<lparr>DMr\<rparr>\<lparr>NTMap\<rparr>\<lparr>B\<rparr>\<rparr> =
	(dmcat_Rel \<alpha> A\<lparr>DMr\<rparr>\<lparr>NTMap\<rparr>\<lparr>B\<rparr>)\<inverse>\<^sub>C\<^bsub>dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<^esub>"
	if "B \<in>\<^sub>\<circ> dmcat_Rel \<alpha> A\<lparr>DMcat\<rparr>\<lparr>Obj\<rparr>" for B
	using assms that
	unfolding dmcat_Rel_components
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Rel_cs_simps
	cs_intro: cat_Rel_is_arrD cat_cs_intros cat_arrow_cs_intros
	)+
	qed
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Subcategory.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Subcategory.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Subcategory.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Subcategory.thy
	@@ -1,762 +1,762 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Subcategory\<close>
	theory CZH_ECAT_Subcategory
	imports
	CZH_ECAT_Functor
	CZH_Foundations.CZH_SMC_Subsemicategory
	begin



	subsection\<open>Background\<close>

	named_theorems cat_sub_cs_intros
	named_theorems cat_sub_bw_cs_intros
	named_theorems cat_sub_fw_cs_intros
	named_theorems cat_sub_bw_cs_simps



	subsection\<open>Simple subcategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale subcategory = sdg: category \<alpha> \<BB> + dg: category \<alpha> \<CC> for \<alpha> \<BB> \<CC> +
	assumes subcat_subsemicategory: "cat_smc \<BB> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	and subcat_CId: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"

	abbreviation is_subcategory ("(_/ \<subseteq>\<^sub>C\<index> _)" [51, 51] 50)
	where "\<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<equiv> subcategory \<alpha> \<BB> \<CC>"


	text\<open>Rules.\<close>

	lemma (in subcategory) subcategory_axioms'[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<BB>' = \<BB>"
	shows "\<BB>' \<subseteq>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>"
	unfolding assms by (rule subcategory_axioms)

	lemma (in subcategory) subcategory_axioms''[cat_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<CC>' = \<CC>"
	shows "\<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	unfolding assms by (rule subcategory_axioms)

	mk_ide rf subcategory_def[unfolded subcategory_axioms_def]
	\|intro subcategoryI[intro!]\|
	\|dest subcategoryD[dest]\|
	\|elim subcategoryE[elim!]\|

	lemmas [cat_sub_cs_intros] = subcategoryD(1,2)

	lemma subcategoryI':
	assumes "category \<alpha> \<BB>"
	and "category \<alpha> \<CC>"
	and "\<And>a. a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<BB>\<^esub> b \<Longrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<BB>\<^esub> c; f : a \<mapsto>\<^bsub>\<BB>\<^esub> b \<rbrakk> \<Longrightarrow>
	g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	and "\<And>a. a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	shows "\<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
	interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
	show ?thesis
	by
	(
	intro subcategoryI subsemicategoryI',
	unfold slicing_simps;
	(intro \<BB>.cat_semicategory \<CC>.cat_semicategory assms)?
	)
	qed


	text\<open>A subcategory is a subsemicategory.\<close>

	context subcategory
	begin

	interpretation subsmc: subsemicategory \<alpha> \<open>cat_smc \<BB>\<close> \<open>cat_smc \<CC>\<close>
	by (rule subcat_subsemicategory)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	subcat_Obj_vsubset = subsmc.subsmc_Obj_vsubset
	and subcat_is_arr_vsubset = subsmc.subsmc_is_arr_vsubset
	and subcat_subdigraph_op_dg_op_dg = subsmc.subsmc_subdigraph_op_dg_op_dg
	and subcat_objD = subsmc.subsmc_objD
	and subcat_arrD = subsmc.subsmc_arrD
	and subcat_dom_simp = subsmc.subsmc_dom_simp
	and subcat_cod_simp = subsmc.subsmc_cod_simp
	and subcat_is_arrD = subsmc.subsmc_is_arrD

	lemmas_with [unfolded slicing_simps slicing_commute]:
	subcat_Comp_simp = subsmc.subsmc_Comp_simp
	and subcat_is_idem_arrD = subsmc.subsmc_is_idem_arrD

	end

	lemmas [cat_sub_fw_cs_intros] =
	subcategory.subcat_Obj_vsubset
	subcategory.subcat_is_arr_vsubset
	subcategory.subcat_objD
	subcategory.subcat_arrD
	subcategory.subcat_is_arrD

	lemmas [cat_sub_bw_cs_simps] =
	subcategory.subcat_dom_simp
	subcategory.subcat_cod_simp

	lemmas [cat_sub_fw_cs_intros] =
	subcategory.subcat_is_idem_arrD

	lemmas [cat_sub_bw_cs_simps] =
	subcategory.subcat_Comp_simp


	text\<open>The opposite subcategory.\<close>

	lemma (in subcategory) subcat_subcategory_op_cat: "op_cat \<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	proof(rule subcategoryI)
	show "cat_smc (op_cat \<BB>) \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (op_cat \<CC>)"
	unfolding slicing_commute[symmetric]
	by (intro subsmc_subsemicategory_op_smc subcat_subsemicategory)
	qed (simp_all add: sdg.category_op dg.category_op cat_op_simps subcat_CId)

	lemmas subcat_subcategory_op_cat[intro] = subcategory.subcat_subcategory_op_cat


	text\<open>Elementary properties.\<close>

	lemma (in subcategory) subcat_CId_is_arr[intro]:
	assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<BB>\<^esub> a"
	proof-
	from assms have \<BB>\<CC>: "\<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>" by (simp add: subcat_CId)
	from assms have "\<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<BB>\<^esub> a" by (auto intro: cat_cs_intros)
	then show ?thesis unfolding \<BB>\<CC> by simp
	qed


	text\<open>Further rules.\<close>

	lemma (in subcategory) subcat_CId_simp[cat_sub_bw_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	using assms by (simp add: subcat_CId)

	lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_CId_simp

	lemma (in subcategory) subcat_is_right_inverseD[cat_sub_fw_cs_intros]:
	assumes "is_right_inverse \<BB> g f"
	shows "is_right_inverse \<CC> g f"
	using assms subcategory_axioms
	by (elim is_right_inverseE, intro is_right_inverseI)
	(
	cs_concl
	cs_simp: cat_sub_bw_cs_simps[symmetric]
	cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
	)

	lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_right_inverseD

	lemma (in subcategory) subcat_is_left_inverseD[cat_sub_fw_cs_intros]:
	assumes "is_left_inverse \<BB> g f"
	shows "is_left_inverse \<CC> g f"
	proof-
	have "op_cat \<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>" by (simp add: subcat_subcategory_op_cat)
	from subcategory.subcat_is_right_inverseD[OF this] show ?thesis
	unfolding cat_op_simps using assms.
	qed

	lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_left_inverseD

	lemma (in subcategory) subcat_is_inverseD[cat_sub_fw_cs_intros]:
	assumes "is_inverse \<BB> g f"
	shows "is_inverse \<CC> g f"
	using assms subcategory_axioms
	by (elim is_inverseE, intro is_inverseI)
	(
	cs_concl
	cs_simp: cat_sub_bw_cs_simps[symmetric]
	cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
	)

	lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_inverseD

	-lemma (in subcategory) subcat_is_arr_isomorphismD[cat_sub_fw_cs_intros]:
	+lemma (in subcategory) subcat_is_iso_arrD[cat_sub_fw_cs_intros]:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	-proof(intro is_arr_isomorphismI)
	- from subcategory_axioms is_arr_isomorphismD(1)[OF assms] show "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	+proof(intro is_iso_arrI)
	+ from subcategory_axioms is_iso_arrD(1)[OF assms] show "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_sub_bw_cs_simps[symmetric] cs_intro: cat_sub_fw_cs_intros
	)
	from assms have "is_inverse \<BB> (f\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>) f"
	by (rule sdg.cat_the_inverse_is_inverse)
	with subcategory_axioms show "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>) f"
	by (elim is_inverseE, intro is_inverseI)
	(
	cs_concl
	cs_simp: cat_sub_bw_cs_simps[symmetric]
	cs_intro: cat_sub_fw_cs_intros cat_cs_intros
	)
	qed

	-lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_arr_isomorphismD
	+lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_iso_arrD

	lemma (in subcategory) subcat_the_inverse_simp[cat_sub_bw_cs_simps]:
	assumes "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	shows "f\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub> = f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	proof-
	from assms have "is_inverse \<BB> (f\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>) f"
	by (auto dest: sdg.cat_the_inverse_is_inverse)
	with subcategory_axioms have inv_f\<BB>: "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>) f"
	by (auto dest: cat_sub_fw_cs_intros)
	from assms have "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b" by (auto dest: cat_sub_fw_cs_intros)
	then have inv_f\<CC>: "is_inverse \<CC> (f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>) f"
	by (auto dest: dg.cat_the_inverse_is_inverse)
	from inv_f\<BB> inv_f\<CC> show ?thesis by (intro dg.cat_is_inverse_eq)
	qed

	lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_the_inverse_simp

	lemma (in subcategory) subcat_obj_isoD:
	assumes "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<BB>\<^esub> b"
	shows "a \<approx>\<^sub>o\<^sub>b\<^sub>j\<^bsub>\<CC>\<^esub> b"
	using assms subcategory_axioms
	by (elim obj_isoE)
	(
	cs_concl cs_shallow
	cs_simp: cat_sub_bw_cs_simps cs_intro: obj_isoI cat_sub_fw_cs_intros
	)

	lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_obj_isoD


	subsubsection\<open>Subcategory relation is a partial order\<close>

	lemma subcat_refl:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret category \<alpha> \<AA> by (rule assms)
	show ?thesis
	by (auto intro: cat_cs_intros slicing_intros subdg_refl subsemicategoryI)
	qed

	lemma subcat_trans:
	assumes "\<AA> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>\<BB>: subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<CC>: subcategory \<alpha> \<BB> \<CC> by (rule assms(2))
	show ?thesis
	proof(rule subcategoryI)
	show "cat_smc \<AA> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	by
	(
	meson
	\<AA>\<BB>.subcat_subsemicategory
	\<BB>\<CC>.subcat_subsemicategory
	subsmc_trans
	)
	qed
	(
	use \<AA>\<BB>.subcategory_axioms \<BB>\<CC>.subcategory_axioms in
	\<open>auto simp: \<AA>\<BB>.subcat_Obj_vsubset cat_sub_bw_cs_simps\<close>
	)
	qed

	lemma subcat_antisym:
	assumes "\<AA> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>\<BB>: subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<AA>: subcategory \<alpha> \<BB> \<AA> by (rule assms(2))
	show ?thesis
	proof(rule cat_eqI)
	from
	subsmc_antisym[
	OF \<AA>\<BB>.subcat_subsemicategory \<BB>\<AA>.subcat_subsemicategory
	]
	have
	"cat_smc \<AA>\<lparr>Obj\<rparr> = cat_smc \<BB>\<lparr>Obj\<rparr>" "cat_smc \<AA>\<lparr>Arr\<rparr> = cat_smc \<BB>\<lparr>Arr\<rparr>"
	by simp_all
	then show Obj: "\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>" and Arr: "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	unfolding slicing_simps by simp_all
	show "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	by (rule vsv_eqI) (auto simp: \<AA>\<BB>.subcat_dom_simp Arr cat_cs_simps)
	show "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	by (rule vsv_eqI) (auto simp: \<BB>\<AA>.subcat_cod_simp Arr cat_cs_simps)
	have "cat_smc \<AA> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>" "cat_smc \<BB> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
	by (simp_all add: \<AA>\<BB>.subcat_subsemicategory \<BB>\<AA>.subcat_subsemicategory)
	from subsmc_antisym[OF this] have "cat_smc \<AA> = cat_smc \<BB>" .
	then have "cat_smc \<AA>\<lparr>Comp\<rparr> = cat_smc \<BB>\<lparr>Comp\<rparr>" by auto
	then show "\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>" unfolding slicing_simps by simp
	show "\<AA>\<lparr>CId\<rparr> = \<BB>\<lparr>CId\<rparr>"
	by (rule vsv_eqI) (auto simp: Obj \<AA>\<BB>.subcat_CId_simp cat_cs_simps)
	qed (auto intro: cat_cs_intros)
	qed



	subsection\<open>Inclusion functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) cf_inc :: "V \<Rightarrow> V \<Rightarrow> V"
	where "cf_inc \<equiv> dghm_inc"


	text\<open>Slicing.\<close>

	lemma dghm_smcf_inc[slicing_commute]:
	"dghm_inc (cat_smc \<BB>) (cat_smc \<CC>) = cf_smcf (cf_inc \<BB> \<CC>)"
	unfolding cf_smcf_def dghm_inc_def cat_smc_def dg_field_simps dghm_field_simps
	by (simp_all add: nat_omega_simps)


	text\<open>Elementary properties.\<close>

	lemmas [cat_cs_simps] =
	dghm_inc_ObjMap_app
	dghm_inc_ArrMap_app


	subsubsection\<open>Canonical inclusion functor associated with a subcategory\<close>

	sublocale subcategory \<subseteq> inc: is_ft_functor \<alpha> \<BB> \<CC> \<open>cf_inc \<BB> \<CC>\<close>
	proof(rule is_ft_functorI)
	interpret subsmc: subsemicategory \<alpha> \<open>cat_smc \<BB>\<close> \<open>cat_smc \<CC>\<close>
	by (rule subcat_subsemicategory)
	show "cf_inc \<BB> \<CC> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule is_functorI)
	show "vfsequence (cf_inc \<BB> \<CC>)" unfolding dghm_inc_def by auto
	show "vcard (cf_inc \<BB> \<CC>) = 4\<^sub>\<nat>"
	unfolding dghm_inc_def by (simp add: nat_omega_simps)
	from sdg.cat_CId_is_arr subcat_CId_simp show "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow>
	cf_inc \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>cf_inc \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	for c
	unfolding dghm_inc_components by force
	from subsmc.inc.is_ft_semifunctor_axioms show
	"cf_smcf (cf_inc \<BB> \<CC>) : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding slicing_commute by auto
	qed (auto simp: dghm_inc_components cat_cs_intros)
	from subsmc.inc.is_ft_semifunctor_axioms show
	"cf_smcf (cf_inc \<BB> \<CC>) : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding slicing_commute by auto
	qed

	lemmas (in subcategory) subcat_cf_inc_is_ft_functor = inc.is_ft_functor_axioms


	subsubsection\<open>Inclusion functor for the opposite categories\<close>

	lemma (in subcategory) subcat_cf_inc_op_cat_is_functor:
	"cf_inc (op_cat \<BB>) (op_cat \<CC>) : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by
	(
	intro
	subcategory.subcat_cf_inc_is_ft_functor
	subcat_subcategory_op_cat
	)

	lemma (in subcategory) subcat_op_cat_cf_inc:
	"cf_inc (op_cat \<BB>) (op_cat \<CC>) = op_cf (cf_inc \<BB> \<CC>)"
	by (rule cf_eqI)
	(
	auto
	simp:
	cat_op_simps
	dghm_inc_components
	subcat_cf_inc_op_cat_is_functor
	is_ft_functor.axioms(1)
	intro: cat_op_intros
	)



	subsection\<open>Full subcategory\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale fl_subcategory = subcategory +
	assumes fl_subcat_fl_subsemicategory: "cat_smc \<BB> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"

	abbreviation is_fl_subcategory ("(_/ \<subseteq>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)" [51, 51] 50)
	where "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC> \<equiv> fl_subcategory \<alpha> \<BB> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf fl_subcategory_def[unfolded fl_subcategory_axioms_def]
	\|intro fl_subcategoryI\|
	\|dest fl_subcategoryD[dest]\|
	\|elim fl_subcategoryE[elim!]\|

	lemmas [cat_sub_cs_intros] = fl_subcategoryD(1)


	text\<open>Elementary properties.\<close>

	sublocale fl_subcategory \<subseteq> inc: is_fl_functor \<alpha> \<BB> \<CC> \<open>cf_inc \<BB> \<CC>\<close>
	proof(rule is_fl_functorI)
	interpret fl_subsemicategory \<alpha> \<open>cat_smc \<BB>\<close> \<open>cat_smc \<CC>\<close>
	by (rule fl_subcat_fl_subsemicategory)
	from inc.is_fl_semifunctor_axioms show
	- "cf_smcf (dghm_inc \<BB> \<CC>) : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	+ "cf_smcf (cf_inc \<BB> \<CC>) : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
	unfolding slicing_commute by simp
	qed (rule inc.is_functor_axioms)



	subsection\<open>Wide subcategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	See
	\cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/wide+subcategory}
	}.
	\<close>

	locale wide_subcategory = subcategory +
	assumes wide_subcat_wide_subsemicategory: "cat_smc \<BB> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"

	abbreviation is_wide_subcategory ("(_/ \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<index> _)" [51, 51] 50)
	where "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<CC> \<equiv> wide_subcategory \<alpha> \<BB> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf wide_subcategory_def[unfolded wide_subcategory_axioms_def]
	\|intro wide_subcategoryI\|
	\|dest wide_subcategoryD[dest]\|
	\|elim wide_subcategoryE[elim!]\|

	lemmas [cat_sub_cs_intros] = wide_subcategoryD(1)


	text\<open>Wide subcategory is wide subsemicategory.\<close>

	context wide_subcategory
	begin

	interpretation wide_subsmc: wide_subsemicategory \<alpha> \<open>cat_smc \<BB>\<close> \<open>cat_smc \<CC>\<close>
	by (rule wide_subcat_wide_subsemicategory)

	lemmas_with [unfolded slicing_simps]:
	wide_subcat_Obj[dg_sub_bw_cs_intros] = wide_subsmc.wide_subsmc_Obj
	and wide_subcat_obj_eq[dg_sub_bw_cs_simps] = wide_subsmc.wide_subsmc_obj_eq

	end

	lemmas [cat_sub_bw_cs_simps] = wide_subcategory.wide_subcat_obj_eq[symmetric]
	lemmas [cat_sub_bw_cs_simps] = wide_subsemicategory.wide_subsmc_obj_eq


	subsubsection\<open>The wide subcategory relation is a partial order\<close>

	lemma wide_subcat_refl:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret category \<alpha> \<AA> by (rule assms)
	show ?thesis
	by
	(
	auto intro:
	assms
	slicing_intros
	wide_subsmc_refl
	wide_subcategoryI
	subsmc_refl
	)
	qed

	lemma wide_subcat_trans[trans]:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>\<BB>: wide_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<CC>: wide_subcategory \<alpha> \<BB> \<CC> by (rule assms(2))
	show ?thesis
	by
	(
	intro
	wide_subcategoryI
	subcat_trans[OF \<AA>\<BB>.subcategory_axioms \<BB>\<CC>.subcategory_axioms],
	rule wide_subsmc_trans,
	rule \<AA>\<BB>.wide_subcat_wide_subsemicategory,
	rule \<BB>\<CC>.wide_subcat_wide_subsemicategory
	)
	qed

	lemma wide_subcat_antisym:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>\<BB>: wide_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<AA>: wide_subcategory \<alpha> \<BB> \<AA> by (rule assms(2))
	show ?thesis
	by (rule subcat_antisym[OF \<AA>\<BB>.subcategory_axioms \<BB>\<AA>.subcategory_axioms])
	qed



	subsection\<open>Replete subcategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	text\<open>
	See nLab
	\cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/replete+subcategory}
	}.
	\<close>

	locale replete_subcategory = subcategory \<alpha> \<BB> \<CC> for \<alpha> \<BB> \<CC> +
	- assumes rep_subcat_is_arr_isomorphism_is_arr:
	+ assumes rep_subcat_is_iso_arr_is_arr:
	"a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b \<Longrightarrow> f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"

	abbreviation is_replete_subcategory ("(_/ \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<index> _)" [51, 51] 50)
	where "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<CC> \<equiv> replete_subcategory \<alpha> \<BB> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf replete_subcategory_def[unfolded replete_subcategory_axioms_def]
	\|intro replete_subcategoryI\|
	\|dest replete_subcategoryD[dest]\|
	\|elim replete_subcategoryE[elim!]\|

	lemmas [cat_sub_cs_intros] = replete_subcategoryD(1)


	text\<open>Elementary properties.\<close>

	lemma (in replete_subcategory) (not cat_sub_intro)
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left:
	+ rep_subcat_is_iso_arr_is_iso_arr_left:
	assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	-proof(intro is_arr_isomorphismI is_inverseI)
	+proof(intro is_iso_arrI is_inverseI)
	from assms show f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	- by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
	+ by (auto intro: rep_subcat_is_iso_arr_is_arr)
	have "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	- by (rule dg.cat_the_inverse_is_arr_isomorphism[OF assms(2)])
	+ by (rule dg.cat_the_inverse_is_iso_arr[OF assms(2)])
	with f show inv_f: "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^bsub>\<BB>\<^esub> a"
	- by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
	+ by (auto intro: rep_subcat_is_iso_arr_is_arr)
	show "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" by (rule f)
	from dg.category_axioms assms have [cat_sub_bw_cs_simps]:
	"f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from dg.category_axioms assms have [cat_sub_bw_cs_simps]:
	"f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = \<CC>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from subcategory_axioms f inv_f show "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = \<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
	from subcategory_axioms f inv_f show "f \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> = \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma (in replete_subcategory) (not cat_sub_intro)
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right:
	+ rep_subcat_is_iso_arr_is_iso_arr_right:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	proof-
	from assms(2) have "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> a"
	- by (rule dg.cat_the_inverse_is_arr_isomorphism)
	+ by (rule dg.cat_the_inverse_is_iso_arr)
	with assms(1) have inv_f: "f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> : b \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> a"
	- by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left)
	+ by (intro rep_subcat_is_iso_arr_is_iso_arr_left)
	then have "(f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub> : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	- by (rule sdg.cat_the_inverse_is_arr_isomorphism)
	+ by (rule sdg.cat_the_inverse_is_iso_arr)
	moreover from replete_subcategory_axioms assms inv_f have "(f\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>)\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub> = f"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_sub_bw_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	ultimately show ?thesis by simp
	qed

	lemma (in replete_subcategory) (not cat_sub_bw_cs_simps)
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left_iff:
	+ rep_subcat_is_iso_arr_is_iso_arr_left_iff:
	assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	using assms replete_subcategory_axioms
	by (intro iffI)
	(
	cs_concl cs_intro:
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left
	+ rep_subcat_is_iso_arr_is_iso_arr_left
	cat_sub_fw_cs_intros
	)

	lemma (in replete_subcategory) (not cat_sub_bw_cs_simps)
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right_iff:
	+ rep_subcat_is_iso_arr_is_iso_arr_right_iff:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	using assms replete_subcategory_axioms
	by (intro iffI)
	(
	cs_concl cs_intro:
	- rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right
	+ rep_subcat_is_iso_arr_is_iso_arr_right
	cat_sub_fw_cs_intros
	)


	subsubsection\<open>The replete subcategory relation is a partial order\<close>

	lemma rep_subcat_refl:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret category \<alpha> \<AA> by (rule assms)
	show ?thesis
	- by (intro replete_subcategoryI subcat_refl assms is_arr_isomorphismD(1))
	+ by (intro replete_subcategoryI subcat_refl assms is_iso_arrD(1))
	qed

	lemma rep_subcat_trans[trans]:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>\<BB>: replete_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<CC>: replete_subcategory \<alpha> \<BB> \<CC> by (rule assms(2))
	show ?thesis
	proof
	(
	intro
	replete_subcategoryI
	subcat_trans[OF \<AA>\<BB>.subcategory_axioms \<BB>\<CC>.subcategory_axioms]
	)
	fix a b f assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	have "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	rule \<AA>\<BB>.dg.cat_is_arrD(3)
	[
	- OF \<BB>\<CC>.rep_subcat_is_arr_isomorphism_is_arr[
	+ OF \<BB>\<CC>.rep_subcat_is_iso_arr_is_arr[
	OF \<AA>\<BB>.subcat_objD[OF prems(1)] prems(2)
	]
	]
	)
	then have "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	by
	(
	- rule \<BB>\<CC>.rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right[
	+ rule \<BB>\<CC>.rep_subcat_is_iso_arr_is_iso_arr_right[
	OF _ prems(2)
	]
	)
	then show "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	- by (rule \<AA>\<BB>.rep_subcat_is_arr_isomorphism_is_arr[OF prems(1)])
	+ by (rule \<AA>\<BB>.rep_subcat_is_iso_arr_is_arr[OF prems(1)])
	qed
	qed

	lemma rep_subcat_antisym:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>r\<^sub>e\<^sub>p\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>\<BB>: replete_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<AA>: replete_subcategory \<alpha> \<BB> \<AA> by (rule assms(2))
	show ?thesis
	by (rule subcat_antisym[OF \<AA>\<BB>.subcategory_axioms \<BB>\<AA>.subcategory_axioms])
	qed



	subsection\<open>Wide replete subcategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale wide_replete_subcategory =
	wide_subcategory \<alpha> \<BB> \<CC> + replete_subcategory \<alpha> \<BB> \<CC> for \<alpha> \<BB> \<CC>

	abbreviation is_wide_replete_subcategory ("(_/ \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<index> _)" [51, 51] 50)
	where "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<CC> \<equiv> wide_replete_subcategory \<alpha> \<BB> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf wide_replete_subcategory_def
	\|intro wide_replete_subcategoryI\|
	\|dest wide_replete_subcategoryD[dest]\|
	\|elim wide_replete_subcategoryE[elim!]\|

	lemmas [cat_sub_cs_intros] = wide_replete_subcategoryD


	text\<open>Wide replete subcategory preserves isomorphisms.\<close>

	lemma (in wide_replete_subcategory)
	- wr_subcat_is_arr_isomorphism_is_arr_isomorphism:
	+ wr_subcat_is_iso_arr_is_iso_arr:
	"f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	proof(rule iffI)
	assume prems: "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> b"
	then have "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	then have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by (simp add: wide_subcat_obj_eq)
	show "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> b"
	- by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left[OF a prems])
	+ by (intro rep_subcat_is_iso_arr_is_iso_arr_left[OF a prems])
	qed
	(
	use wide_replete_subcategory_axioms in
	\<open>cs_concl cs_shallow cs_intro: cat_sub_fw_cs_intros \<close>
	)

	lemmas [cat_sub_bw_cs_simps] =
	- wide_replete_subcategory.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
	+ wide_replete_subcategory.wr_subcat_is_iso_arr_is_iso_arr


	subsubsection\<open>The wide replete subcategory relation is a partial order\<close>

	lemma wr_subcat_refl:
	assumes "category \<alpha> \<AA>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro wide_replete_subcategoryI wide_subcat_refl rep_subcat_refl assms)

	lemma wr_subcat_trans[trans]:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>\<BB>: wide_replete_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<CC>: wide_replete_subcategory \<alpha> \<BB> \<CC> by (rule assms(2))
	show ?thesis
	by
	(
	intro wide_replete_subcategoryI,
	rule wide_subcat_trans,
	rule \<AA>\<BB>.wide_subcategory_axioms,
	rule \<BB>\<CC>.wide_subcategory_axioms,
	rule rep_subcat_trans,
	rule \<AA>\<BB>.replete_subcategory_axioms,
	rule \<BB>\<CC>.replete_subcategory_axioms
	)
	qed

	lemma wr_subcat_antisym:
	assumes "\<AA> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<subseteq>\<^sub>C\<^sub>.\<^sub>w\<^sub>r\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>\<BB>: wide_replete_subcategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret \<BB>\<AA>: wide_replete_subcategory \<alpha> \<BB> \<AA> by (rule assms(2))
	show ?thesis
	by (rule subcat_antisym[OF \<AA>\<BB>.subcategory_axioms \<BB>\<AA>.subcategory_axioms])
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
	--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
	+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
	@@ -1,5704 +1,5715 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Yoneda Lemma\<close>
	theory CZH_ECAT_Yoneda
	imports
	CZH_ECAT_FUNCT
	CZH_ECAT_Hom
	begin



	subsection\<open>Yoneda map\<close>


	text\<open>
	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}.
	\<close>

	definition Yoneda_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "Yoneda_map \<alpha> \<KK> r =
	(
	\<lambda>\<psi>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (\<KK>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomDom\<rparr>(r,-) \<KK>.
	\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<KK>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>
	)"


	text\<open>Elementary properties.\<close>

	mk_VLambda Yoneda_map_def
	\|vsv Yoneda_map_vsv[cat_cs_intros]\|

	mk_VLambda (in is_functor) Yoneda_map_def[where \<alpha>=\<alpha> and \<KK>=\<FF>, 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\<open>Yoneda component\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	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}).
	\<close>

	definition Yoneda_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "Yoneda_component \<KK> r u d =
	[
	(\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomDom\<rparr>) r d. \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>),
	Hom (\<KK>\<lparr>HomDom\<rparr>) r d,
	\<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma (in is_functor) Yoneda_component_components:
	shows "Yoneda_component \<FF> r u d\<lparr>ArrVal\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>Hom \<AA> r d. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>)"
	and "Yoneda_component \<FF> r u d\<lparr>ArrDom\<rparr> = Hom \<AA> r d"
	and "Yoneda_component \<FF> r u d\<lparr>ArrCod\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	unfolding Yoneda_component_def arr_field_simps
	by (simp_all add: nat_omega_simps cat_cs_simps)


	subsubsection\<open>Arrow value\<close>

	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\<open>Yoneda component is an arrow in the category \<open>Set\<close>\<close>

	lemma (in category) cat_Yoneda_component_is_arr:
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Yoneda_component \<KK> r u d : Hom \<CC> r d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))
	show ?thesis
	proof(intro cat_Set_is_arrI arr_SetI, unfold \<KK>.Yoneda_component_components)
	show "vfsequence (Yoneda_component \<KK> r u d)"
	unfolding Yoneda_component_def by simp
	show "vcard (Yoneda_component \<KK> r u d) = 3\<^sub>\<nat>"
	unfolding Yoneda_component_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>Hom \<CC> r d. \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>) \<subseteq>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	proof(rule vrange_VLambda_vsubset)
	fix f assume "f \<in>\<^sub>\<circ> Hom \<CC> r d"
	then have \<KK>f: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	by (auto simp: cat_cs_intros)
	note \<KK>f_simps = cat_Set_is_arrD[OF \<KK>f]
	interpret \<KK>f: arr_Set \<alpha> \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close> by (rule \<KK>f_simps(1))
	have "u \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>)"
	by (simp add: \<KK>f_simps assms cat_Set_cs_simps)
	with \<KK>f.arr_Set_ArrVal_vrange[unfolded \<KK>f_simps] show
	"\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr> \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	by (blast elim: \<KK>f.ArrVal.vsv_value)
	qed
	from assms \<KK>.HomCod.cat_Obj_vsubset_Vset show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto dest: \<KK>.cf_ObjMap_app_in_HomCod_Obj)
	qed (auto simp: assms cat_cs_intros)
	qed

	lemma (in category) cat_Yoneda_component_is_arr':
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s = Hom \<CC> r d"
	and "t = \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	and "\<DD> = cat_Set \<alpha>"
	shows "Yoneda_component \<KK> r u d : s \<mapsto>\<^bsub>\<DD>\<^esub> 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\<open>Yoneda arrow\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	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}.
	\<close>

	definition Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "Yoneda_arrow \<alpha> \<KK> r u =
	[
	(\<lambda>d\<in>\<^sub>\<circ>\<KK>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. Yoneda_component \<KK> r u d),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomDom\<rparr>(r,-),
	\<KK>,
	\<KK>\<lparr>HomDom\<rparr>,
	cat_Set \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma (in is_functor) Yoneda_arrow_components:
	shows "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTMap\<rparr> =
	(\<lambda>d\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. Yoneda_component \<FF> r u d)"
	and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)"
	and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTCod\<rparr> = \<FF>"
	and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDGDom\<rparr> = \<AA>"
	and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding Yoneda_arrow_def nt_field_simps
	by (simp_all add: nat_omega_simps cat_cs_simps)


	subsubsection\<open>Natural transformation map\<close>

	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\<open>Yoneda arrow is a natural transformation\<close>

	lemma (in category) cat_Yoneda_arrow_is_ntcf:
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "Yoneda_arrow \<alpha> \<KK> r u : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-

	interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))
	note \<KK>ru = cat_Yoneda_component_is_arr[OF assms]
	let ?\<KK>ru = \<open>Yoneda_component \<KK> r u\<close>

	show ?thesis
	proof(intro is_ntcfI', unfold \<KK>.Yoneda_arrow_components)

	show "vfsequence (Yoneda_arrow \<alpha> \<KK> r u)"
	unfolding Yoneda_arrow_def by simp
	show "vcard (Yoneda_arrow \<alpha> \<KK> r u) = 5\<^sub>\<nat>"
	unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)

	show
	"(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>a\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 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
	"(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	proof-

	note \<MM>a = \<KK>ru[OF cat_is_arrD(2)[OF that]]
	note \<MM>b = \<KK>ru[OF cat_is_arrD(3)[OF that]]

	from category_axioms assms that \<MM>b have b_f:
	"?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ> :
	Hom \<CC> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>) =
	Hom \<CC> r a"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms that \<MM>a have f_a:
	"\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a :
	Hom \<CC> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>) = Hom \<CC> r a"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	have [cat_cs_simps]:
	"?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ> =
	\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a"
	proof(rule arr_Set_eqI[of \<alpha>])

	from b_f show arr_Set_b_f:
	"arr_Set \<alpha> (?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)"
	by (auto simp: cat_Set_is_arrD(1))
	interpret b_f: arr_Set \<alpha> \<open>?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>\<close>
	by (rule arr_Set_b_f)
	from f_a show arr_Set_f_a:
	"arr_Set \<alpha> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)"
	by (auto simp: cat_Set_is_arrD(1))
	interpret f_a: arr_Set \<alpha> \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a\<close>
	by (rule arr_Set_f_a)

	show
	"(?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr> =
	(\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix q assume "q : r \<mapsto>\<^bsub>\<CC>\<^esub> a"
	from category_axioms assms that this \<MM>a \<MM>b show
	"(?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> =
	(\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr>"
	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 \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	from that category_axioms assms \<MM>a \<MM>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\<open>Yoneda Lemma\<close>

	text\<open>
	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}).
	\<close>

	lemma (in category) cat_Yoneda_Lemma:
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "v11 (Yoneda_map \<alpha> \<KK> r)"
	and "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)"
	proof-

	interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))

	from assms(2) \<KK>.HomCod.cat_Obj_vsubset_Vset \<KK>.cf_ObjMap_app_in_HomCod_Obj
	have \<KK>r_in_Vset: "\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto

	show Ym: "v11 (Yoneda_map \<alpha> \<KK> r)"
	proof(intro vsv.vsv_valeq_v11I, unfold \<KK>.Yoneda_map_vdomain these_ntcfs_iff)

	fix \<MM> \<NN>
	assume prems:
	"\<MM> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	"\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	"Yoneda_map \<alpha> \<KK> r\<lparr>\<MM>\<rparr> = Yoneda_map \<alpha> \<KK> r\<lparr>\<NN>\<rparr>"
	from prems(3) have \<MM>r_\<NN>r:
	"\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	unfolding
	Yoneda_map_app[OF assms(1) prems(1)]
	Yoneda_map_app[OF assms(1) prems(2)]
	by simp

	interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<MM>
	by (rule prems(1))
	interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<NN>
	by (rule prems(2))

	show "\<MM> = \<NN>"
	proof
	(
	rule ntcf_eqI[OF prems(1,2)];
	(rule refl)?;
	rule vsv_eqI,
	unfold \<MM>.ntcf_NTMap_vdomain \<NN>.ntcf_NTMap_vdomain
	)

	fix d assume prems': "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"

	note \<MM>d_simps = cat_Set_is_arrD[OF \<MM>.ntcf_NTMap_is_arr[OF prems']]
	interpret \<MM>d: arr_Set \<alpha> \<open>\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<close> by (rule \<MM>d_simps(1))

	note \<NN>d_simps = cat_Set_is_arrD[OF \<NN>.ntcf_NTMap_is_arr[OF prems']]
	interpret \<NN>d: arr_Set \<alpha> \<open>\<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<close> by (rule \<NN>d_simps(1))

	show "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	proof(rule arr_Set_eqI[of \<alpha>])
	show "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold
	\<NN>d.arr_Set_ArrVal_vdomain
	\<MM>d.arr_Set_ArrVal_vdomain
	\<MM>d_simps
	\<NN>d_simps
	)
	fix f assume prems'': "f \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	from prems'' prems' category_axioms assms(2) have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> d"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_op_intros)
	from \<MM>.ntcf_Comp_commute[OF f] have
	"(
	\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
	)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> =
	(\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	by simp
	from this category_axioms assms(2) f prems prems' have \<MM>df:
	"\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>\<rparr>"
	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 \<NN>.ntcf_Comp_commute[OF f] have
	"(
	\<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
	)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> =
	(\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	by simp
	from this category_axioms assms(2) f prems prems' have \<NN>df:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>\<rparr>"
	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 "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	unfolding \<MM>df \<NN>df \<MM>r_\<NN>r by simp
	qed auto

	qed (simp_all add: \<MM>d_simps \<NN>d_simps)

	qed auto

	qed (auto simp: Yoneda_map_vsv)

	interpret Ym: v11 \<open>Yoneda_map \<alpha> \<KK> r\<close> by (rule Ym)

	have YY: "Yoneda_map \<alpha> \<KK> r\<lparr>Yoneda_arrow \<alpha> \<KK> r a\<rparr> = a"
	if "a \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>" for a
	proof-
	note cat_Yoneda_arrow_is_ntcf[OF assms that]
	moreover with assms have Ya: "Yoneda_arrow \<alpha> \<KK> r a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)"
	by
	(
	cs_concl cs_shallow
	cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
	)
	ultimately show "Yoneda_map \<alpha> \<KK> r\<lparr>Yoneda_arrow \<alpha> \<KK> r a\<rparr> = a"
	using assms that \<KK>r_in_Vset
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	show [simp]: "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) \<subseteq>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	unfolding Yoneda_map_def
	proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff \<KK>.cf_HomDom)
	fix \<MM> assume prems: "\<MM> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	then interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<MM> .
	note \<MM>r_simps = cat_Set_is_arrD[OF \<MM>.ntcf_NTMap_is_arr[OF assms(2)]]
	interpret \<MM>r: arr_Set \<alpha> \<open>\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<close> by (rule \<MM>r_simps(1))
	from prems category_axioms assms(2) have
	"\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>)"
	unfolding \<MM>r.arr_Set_ArrVal_vdomain \<MM>r_simps
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	then have "\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>)"
	by (blast elim: \<MM>r.ArrVal.vsv_value)
	then show "\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by (auto simp: \<MM>r_simps dest!: vsubsetD[OF \<MM>r.arr_Set_ArrVal_vrange])
	qed

	show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)"
	proof(intro vsubsetI)
	fix u assume prems: "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	from cat_Yoneda_arrow_is_ntcf[OF assms prems] have
	"Yoneda_arrow \<alpha> \<KK> r u \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> 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 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)"
	by (force dest!: vdomain_atD)
	qed

	qed

	show "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)"
	proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
	from Ym show "vsv ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>)" by auto
	show "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>\<lparr>a\<rparr> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)" for a
	proof-
	from that have a: "a \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>" by simp
	note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
	then have "Yoneda_arrow \<alpha> \<KK> r a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> 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 \<KK>.Yoneda_map_vdomain these_ntcfs_iff
	]
	)
	(simp_all add: these_ntcfs_iff cat_cs_simps)
	qed
	qed auto

	qed



	subsection\<open>Inverse of the Yoneda map\<close>

	lemma (in category) inv_Yoneda_map_v11:
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "v11 ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>)"
	using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

	lemma (in category) inv_Yoneda_map_vdomain:
	assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	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 "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>\<lparr>u\<rparr> = Yoneda_arrow \<alpha> \<KK> 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 "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "\<R>\<^sub>\<circ> ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>) =
	these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<KK>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))
	show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
	qed



	subsection\<open>
	Component of a composition of a \<open>Hom\<close>-natural transformation
	with natural transformations
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following definition is merely a technical generalization
	that is used in the context of the description of the
	composition of a \<open>Hom\<close>-natural transformation with a natural transformation
	later in this section
	(also see subsection 1.15 in \cite{bodo_categories_1970}).
	\<close>

	definition ntcf_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_Hom_component \<phi> \<psi> a b =
	[
	(
	\<lambda>f\<in>\<^sub>\<circ>Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>).
	\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> f \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>
	),
	Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>),
	Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_Hom_component_components:
	shows "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>).
	\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> f \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>
	)"
	and "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> =
	Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> =
	Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding ntcf_Hom_component_def arr_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow value\<close>

	mk_VLambda ntcf_Hom_component_components(1)
	\|vsv ntcf_Hom_component_ArrVal_vsv[intro]\|

	context
	fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
	assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
	interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)

	mk_VLambda
	ntcf_Hom_component_components(1)
	[
	of \<phi> \<psi>,
	unfolded
	\<phi>.ntcf_NTDom \<psi>.ntcf_NTDom
	\<phi>.ntcf_NTCod \<psi>.ntcf_NTCod
	\<phi>.ntcf_NTDGDom \<psi>.ntcf_NTDGDom
	\<phi>.ntcf_NTDGCod \<psi>.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 \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows
	"\<R>\<^sub>\<circ> (ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
	)
	fix f assume "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	with assms \<phi> \<psi> show
	"ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (rule ntcf_Hom_component_ArrVal_vsv)

	end


	subsubsection\<open>Arrow domain and codomain\<close>

	context
	fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
	assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
	interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)

	lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
	"ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

	lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
	"ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

	end


	subsubsection\<open>
	Component of a composition of a \<open>Hom\<close>-natural transformation
	with natural transformations is an arrow in the category \<open>Set\<close>
	\<close>

	lemma (in category) cat_ntcf_Hom_component_is_arr:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows
	"ntcf_Hom_component \<phi> \<psi> a b :
	Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-

	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))

	from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp

	show ?thesis
	proof(intro cat_Set_is_arrI arr_SetI)
	show "vfsequence (ntcf_Hom_component \<phi> \<psi> a b)"
	unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
	show "vcard (ntcf_Hom_component \<phi> \<psi> a b) = 3\<^sub>\<nat>"
	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
	"\<R>\<^sub>\<circ> (ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms(1,2,4) a show "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(1,2,4) a show "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (use assms in \<open>auto simp: ntcf_Hom_component_components cat_cs_simps\<close>)

	qed

	lemma (in category) cat_ntcf_Hom_component_is_arr':
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "\<BB>' = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "\<CC>' = cat_Set \<alpha>"
	shows "ntcf_Hom_component \<phi> \<psi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
	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\<open>
	Naturality of the components of a composition of
	a \<open>Hom\<close>-natural transformation with natural transformations
	\<close>

	lemma (in category) cat_ntcf_Hom_component_nat:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "g : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> a'"
	and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	shows
	"ntcf_Hom_component \<phi> \<psi> a' b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_hom \<CC> [\<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> =
	cf_hom \<CC> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	ntcf_Hom_component \<phi> \<psi> a b"
	proof-

	let ?Y_ab = \<open>ntcf_Hom_component \<phi> \<psi> a b\<close>
	and ?Y_a'b' = \<open>ntcf_Hom_component \<phi> \<psi> a' b'\<close>
	and ?\<GG>g = \<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
	and ?\<FF>'f = \<open>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
	and ?\<FF>g = \<open>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
	and ?\<GG>'f = \<open>\<GG>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
	and ?\<GG>a = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
	and ?\<FF>'b = \<open>\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<FF>a' = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>\<close>
	and ?\<GG>'b' = \<open>\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>

	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)

	from assms(3) have g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> a" unfolding cat_op_simps by simp

	from Set.category_axioms category_axioms assms g have a'b_Gg\<FF>'f:
	"?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ> :
	Hom \<CC> ?\<GG>a ?\<FF>'b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a' ?\<GG>'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:
	"\<D>\<^sub>\<circ> ((?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>) =
	Hom \<CC> ?\<GG>a ?\<FF>'b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from Set.category_axioms category_axioms assms g have \<FF>g\<GG>'f_ab:
	"cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab :
	Hom \<CC> ?\<GG>a ?\<FF>'b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a' ?\<GG>'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:
	"\<D>\<^sub>\<circ> ((cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>) =
	Hom \<CC> ?\<GG>a ?\<FF>'b"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from a'b_Gg\<FF>'f show arr_Set_a'b_Gg\<FF>'f:
	"arr_Set \<alpha> (?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)"
	by (auto dest: cat_Set_is_arrD(1))
	from \<FF>g\<GG>'f_ab show arr_Set_\<FF>g\<GG>'f_ab:
	"arr_Set \<alpha> (cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr> =
	(cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix h assume prems: "h : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	from assms(1,2) g have [cat_cs_simps]:
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<GG>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>))) =
	\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>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 "\<dots> =
	(((\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>'f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g"
	by (cs_concl cs_shallow cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros)
	also from assms(1,2,4) have "\<dots> =
	(((?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>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 "\<dots> =
	?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g)))"
	by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (slow)
	finally have nat:
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<GG>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>))) =
	?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g)))".
	from prems Set.category_axioms category_axioms assms(1,2,4) g show
	"(?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> =
	(cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	by (slow)
	(
	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\<FF>'f arr_Set_\<FF>g\<GG>'f_ab in auto)

	qed (use a'b_Gg\<FF>'f \<FF>g\<GG>'f_ab in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed


	subsubsection\<open>
	Composition of the components of a composition of a \<open>Hom\<close>-natural
	transformation with natural transformations
	\<close>

	lemma (in category) cat_ntcf_Hom_component_Comp:
	assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows
	"ntcf_Hom_component \<phi> \<psi>' a b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_Hom_component \<phi>' \<psi> a b =
	ntcf_Hom_component (\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>) (\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>) a b"
	(is \<open>?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi> = ?\<phi>'\<phi>\<psi>'\<psi>\<close>)
	proof-

	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)

	from assms Set.category_axioms category_axioms have \<phi>\<psi>'_\<phi>'\<psi>:
	"?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi> :
	Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<HH>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr>) =
	Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms Set.category_axioms category_axioms have \<phi>'\<phi>\<psi>'\<psi>:
	"?\<phi>'\<phi>\<psi>'\<psi> :
	Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<HH>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> (?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from \<phi>\<psi>'_\<phi>'\<psi> show arr_Set_\<phi>\<psi>'_\<phi>'\<psi>: "arr_Set \<alpha> (?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)"
	by (auto dest: cat_Set_is_arrD(1))
	from \<phi>'\<phi>\<psi>'\<psi> show arr_Set_\<phi>'\<phi>\<psi>'\<psi>: "arr_Set \<alpha> ?\<phi>'\<phi>\<psi>'\<psi>"
	by (auto dest: cat_Set_is_arrD(1))
	show "(?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr> = ?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix f assume "f : \<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	with category_axioms assms Set.category_axioms show
	"(?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = ?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	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_\<phi>'\<phi>\<psi>'\<psi> arr_Set_\<phi>\<psi>'_\<phi>'\<psi> in auto)

	qed (use \<phi>\<psi>'_\<phi>'\<psi> \<phi>'\<phi>\<psi>'\<psi> in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+

	qed

	lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp


	subsubsection\<open>
	Component of a composition of \<open>Hom\<close>-natural
	transformation with the identity natural transformations
	\<close>

	lemma (in category) cat_ntcf_Hom_component_ntcf_id:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF>': \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows
	"ntcf_Hom_component (ntcf_id \<FF>) (ntcf_id \<FF>') a b =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<rparr>"
	(is \<open>?\<FF>\<FF>' = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<close>)
	proof-

	interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
	interpret \<FF>': is_functor \<alpha> \<BB> \<CC> \<FF>' by (rule assms(2))
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)

	from assms Set.category_axioms category_axioms have \<FF>\<FF>':
	"?\<FF>\<FF>' :
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
	then have dom_lhs: "\<D>\<^sub>\<circ> (?\<FF>\<FF>'\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_simp: cat_cs_simps)

	from category_axioms assms Set.category_axioms have \<FF>a\<FF>'b:
	"cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr> :
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_Set_cs_simps cat_Set_components(1)
	cs_intro: cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from \<FF>\<FF>' show arr_Set_\<FF>\<psi>: "arr_Set \<alpha> ?\<FF>\<FF>'"
	by (auto dest: cat_Set_is_arrD(1))
	from \<FF>a\<FF>'b show arr_Set_\<FF>a\<FF>'b: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	show "?\<FF>\<FF>'\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix f assume "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	with category_axioms Set.category_axioms assms show
	"?\<FF>\<FF>'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_Set_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	qed (use arr_Set_\<FF>a\<FF>'b in auto)

	qed (use \<FF>\<FF>' \<FF>a\<FF>'b in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+

	qed

	lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id



	subsection\<open>
	Component of a composition of a \<open>Hom\<close>-natural transformation
	with a natural transformation
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition ntcf_lcomp_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_lcomp_Hom_component \<phi> a b =
	ntcf_Hom_component \<phi> (ntcf_id (cf_id (\<phi>\<lparr>NTDGCod\<rparr>))) a b"

	definition ntcf_rcomp_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_rcomp_Hom_component \<psi> a b =
	ntcf_Hom_component (ntcf_id (cf_id (\<psi>\<lparr>NTDGCod\<rparr>))) \<psi> a b"


	subsubsection\<open>Arrow value\<close>

	lemma ntcf_lcomp_Hom_component_ArrVal_vsv:
	"vsv (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>)"
	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 \<psi> a b\<lparr>ArrVal\<rparr>)"
	unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)

	lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	show ?thesis
	using assms
	unfolding ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	show ?thesis
	using assms
	unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "h : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	show ?thesis
	using assms
	unfolding cat_op_simps ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "h : a \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	show ?thesis
	using assms
	unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma ntcf_lcomp_Hom_component_ArrVal_vrange:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms(2) have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	from assms(1,3) a have
	"\<R>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	unfold cat_op_simps ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms(2) have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	from assms(1,3) a have
	"\<R>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	unfold ntcf_rcomp_Hom_component_def \<psi>.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\<open>Arrow domain and codomain\<close>

	lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms show ?thesis
	unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms show ?thesis
	unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed


	subsubsection\<open>
	Component of a composition of a \<open>Hom\<close>-natural transformation
	with a natural transformation is an arrow in the category \<open>Set\<close>
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_lcomp_Hom_component \<phi> a b :
	Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	from assms(1,3) a have
	"ntcf_lcomp_Hom_component \<phi> a b :
	Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding ntcf_lcomp_Hom_component_def \<phi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<AA>' = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	and "\<BB>' = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	and "\<CC>' = cat_Set \<alpha>"
	shows "ntcf_lcomp_Hom_component \<phi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
	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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "ntcf_rcomp_Hom_component \<psi> a b :
	Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	from assms(1,3) a have
	"ntcf_rcomp_Hom_component \<psi> a b :
	Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding ntcf_rcomp_Hom_component_def \<psi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>' = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "\<BB>' = Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "\<CC>' = cat_Set \<alpha>"
	shows "ntcf_rcomp_Hom_component \<psi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
	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\<open>
	Composition of a \<open>Hom\<close>-natural transformation with two natural transformations
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See subsection 1.15 in \cite{bodo_categories_1970}.\<close>

	definition ntcf_Hom :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/_-,_-/')\<close>)
	where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) =
	[
	(
	\<lambda>ab\<in>\<^sub>\<circ>(op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
	ntcf_Hom_component \<phi> \<psi> (vpfst ab) (vpsnd ab)
	),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTCod\<rparr>-,\<psi>\<lparr>NTDom\<rparr>-),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTDom\<rparr>-,\<psi>\<lparr>NTCod\<rparr>-),
	op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>,
	cat_Set \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_Hom_components:
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr> =
	(
	\<lambda>ab\<in>\<^sub>\<circ>(op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
	ntcf_Hom_component \<phi> \<psi> (vpfst ab) (vpsnd ab)
	)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDom\<rparr> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTCod\<rparr>-,\<psi>\<lparr>NTDom\<rparr>-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTCod\<rparr> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTDom\<rparr>-,\<psi>\<lparr>NTCod\<rparr>-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDGDom\<rparr> = op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda ntcf_Hom_components(1)
	\|vsv ntcf_Hom_NTMap_vsv\|

	context
	fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
	assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
	interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)

	mk_VLambda ntcf_Hom_components(1)[of _ \<phi> \<psi>, 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]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_Hom_component \<phi> \<psi> 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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> 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 \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	rule cat_prod_2_ObjE[
	OF \<phi>.NTDom.HomDom.category_op \<psi>.NTDom.HomDom.category_axioms
	]
	)
	from assms a b category_cat_Set category_axioms show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	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\<open>
	Composition of a \<open>Hom\<close>-natural transformation with
	two natural transformations is a natural transformation
	\<close>

	lemma (in category) cat_ntcf_Hom_is_ntcf:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-) :
	op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-

	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))

	show ?thesis
	proof(intro is_ntcfI')
	show "vfsequence (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-))" unfolding ntcf_Hom_def by simp
	show "vcard (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)) = 5\<^sub>\<nat>"
	unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
	from assms category_axioms show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-) : op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms category_axioms show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-) : op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	if "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab
	proof-
	from that obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	rule cat_prod_2_ObjE[
	OF \<phi>.NTDom.HomDom.category_op \<psi>.NTDom.HomDom.category_axioms
	]
	)
	from category_axioms assms a b show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
	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\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a'b'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
	if "gf : ab \<mapsto>\<^bsub>op_cat \<AA> \<times>\<^sub>C \<BB>\<^esub> a'b'" for ab a'b' gf
	proof-
	from that obtain g f a b a' b'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a'b'_def: "a'b' = [a', b']\<^sub>\<circ>"
	and g: "g : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> a'"
	and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	by
	(
	elim
	cat_prod_2_is_arrE[
	OF \<phi>.NTDom.HomDom.category_op \<psi>.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 (slow)
	(
	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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<beta> = \<alpha>"
	and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)"
	and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)"
	and "\<CC>' = op_cat \<AA> \<times>\<^sub>C \<BB>"
	and "\<DD>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
	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\<open>
	Composition of a \<open>Hom\<close>-natural transformation with
	two vertical compositions of natural transformations
	\<close>

	lemma (in category) cat_ntcf_Hom_vcomp:
	assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-) =
	Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-)"
	proof(rule ntcf_eqI[of \<alpha>])

	interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
	interpret \<psi>': is_ntcf \<alpha> \<BB> \<CC> \<GG>' \<HH>' \<psi>' by (rule assms(3))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(4))

	from category_axioms assms show H_vcomp:
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<HH>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<HH>'-) :
	op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from category_axioms assms show vcomp_H:
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<HH>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<HH>'-) :
	op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	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:
	"\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	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:
	"\<D>\<^sub>\<circ> ((Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>) =
	(op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr> =
	(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
	fix ab assume prems: "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	auto
	elim:
	cat_prod_2_ObjE[
	OF \<phi>'.NTDom.HomDom.category_op \<psi>'.NTDom.HomDom.category_axioms
	]
	simp: cat_op_simps
	)
	from
	assms a b
	category_axioms
	\<phi>'.NTDom.HomDom.category_axioms
	\<psi>'.NTDom.HomDom.category_axioms
	show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> =
	(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
	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 "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF>': \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)"
	proof(rule ntcf_eqI[of \<alpha>])

	interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
	interpret \<FF>': is_functor \<alpha> \<BB> \<CC> \<FF>' by (rule assms(2))

	from category_axioms assms show H_id:
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
	op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	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\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
	op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	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:
	"\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	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:
	"\<D>\<^sub>\<circ> (ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr> =
	ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
	show "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>)"
	by (rule ntcf_Hom_NTMap_vsv)
	from id_H show "vsv (ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>)"
	by (intro is_functor.ntcf_id_NTMap_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	fix ab assume "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by
	(
	auto
	elim:
	cat_prod_2_ObjE[OF \<FF>.HomDom.category_op \<FF>'.HomDom.category_axioms]
	simp: cat_op_simps
	)
	from category_axioms assms a b H_id id_H show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> =
	ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
	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\<open>
	Composition of a \<open>Hom\<close>-natural transformation with a natural transformation
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See subsection 1.15 in \cite{bodo_categories_1970}.\<close>

	definition ntcf_lcomp_Hom :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/_-,-/')\<close>)
	where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,ntcf_id (cf_id (\<phi>\<lparr>NTDGCod\<rparr>))-)"

	definition ntcf_rcomp_Hom :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/-,_-/')\<close>)
	where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id (cf_id (\<psi>\<lparr>NTDGCod\<rparr>))-,\<psi>-)"


	subsubsection\<open>Natural transformation map\<close>

	lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>)"
	unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

	lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>)"
	unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

	lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_lcomp_Hom_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_rcomp_Hom_def \<psi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_lcomp_Hom_component \<phi> a b"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms show ?thesis
	unfolding
	ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_rcomp_Hom_component \<psi> a b"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms show ?thesis
	unfolding
	ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def \<psi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def \<phi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms show ?thesis
	unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
	by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
	qed


	subsubsection\<open>
	Composition of a \<open>Hom\<close>-natural transformation with
	a natural transformation is a natural transformation
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) : op_cat \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms category_axioms show ?thesis
	unfolding
	ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] \<phi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<beta> = \<alpha>"
	and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
	and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
	and "\<CC>' = op_cat \<AA> \<times>\<^sub>C \<CC>"
	and "\<DD>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
	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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) : op_cat \<CC> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
	from assms category_axioms show ?thesis
	unfolding
	ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] \<psi>.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 "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<beta> = \<alpha>"
	and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-)"
	and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)"
	and "\<CC>' = op_cat \<CC> \<times>\<^sub>C \<BB>"
	and "\<DD>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>'"
	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\<open>
	Component of a composition of a \<open>Hom\<close>-natural transformation
	with a natural transformation and the Yoneda component
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows
	"ntcf_lcomp_Hom_component \<phi> b c =
	Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) c"
	(is \<open>?lcomp = ?Yc\<close>)
	proof-

	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))

	from assms(2) have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding cat_op_simps by clarsimp
	from b have \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)
	from assms(1,3) b category_axioms have \<phi>b:
	"\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)

	have lcomp:
	"?lcomp : Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
	by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
	then have dom_lhs: "\<D>\<^sub>\<circ> (?lcomp\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
	by (cs_concl cs_simp: cat_cs_simps)

	have Yc: "?Yc :
	Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by
	(
	rule cat_Yoneda_component_is_arr[
	OF cat_cf_Hom_snd_is_functor[OF \<FF>b] \<GG>b \<phi>b assms(3)
	]
	)
	then have dom_rhs: "\<D>\<^sub>\<circ> (?Yc\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
	by (cs_concl cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])

	from lcomp show "arr_Set \<alpha> ?lcomp" by (auto dest: cat_Set_is_arrD(1))
	from Yc show "arr_Set \<alpha> ?Yc" by (auto dest: cat_Set_is_arrD(1))

	show "?lcomp\<lparr>ArrVal\<rparr> = ?Yc\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	from assms(1) b category_axioms show "vsv (?Yc\<lparr>ArrVal\<rparr>)"
	by (intro is_functor.Yoneda_component_ArrVal_vsv)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "?lcomp\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = ?Yc\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	if "f \<in>\<^sub>\<circ> Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c" for f
	proof-
	from that have "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> 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 \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	with lcomp show "?lcomp\<lparr>ArrCod\<rparr> = ?Yc\<lparr>ArrCod\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)

	qed (use lcomp Yc in \<open>cs_concl cs_simp: cat_cs_simps\<close>)

	qed


	subsubsection\<open>
	Composition of a \<open>Hom\<close>-natural transformation with
	a vertical composition of natural transformations
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
	assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,-)"
	proof-
	interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
	from category_axioms have ntcf_id_cf_id:
	"ntcf_id (cf_id \<CC>) = ntcf_id (cf_id \<CC>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<CC>)"
	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
	\<phi>'.ntcf_NTDGCod
	\<phi>.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 "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>-)"
	proof-
	interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
	interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
	from category_axioms have ntcf_id_cf_id:
	"ntcf_id (cf_id \<CC>) = ntcf_id (cf_id \<CC>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<CC>)"
	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
	\<phi>'.ntcf_NTDGCod
	\<phi>.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\<open>
	Composition of a \<open>Hom\<close>-natural transformation with an identity natural
	transformation
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
	proof-
	interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
	from category_axioms assms show ?thesis
	unfolding ntcf_lcomp_Hom_def ntcf_id_components \<FF>.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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,ntcf_id \<FF>-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-)"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	from category_axioms assms show ?thesis
	unfolding ntcf_rcomp_Hom_def ntcf_id_components \<FF>.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\<open>Projections of a \<open>Hom\<close>-natural transformation\<close>


	text\<open>
	The concept of a projection of a \<open>Hom\<close>-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).
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition ntcf_Hom_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>_'(/_,-/')\<close>)
	where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) =
	Yoneda_arrow \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>,-)) (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>) f"

	definition ntcf_Hom_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>_'(/-,_/')\<close>)
	where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(f,-)"


	text\<open>Components.\<close>

	lemma (in category) cat_ntcf_Hom_snd_components:
	assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTMap\<rparr> =
	(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r f d)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGDom\<rparr> = \<CC>"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	proof-
	interpret is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<close>
	using assms category_axioms by (cs_concl cs_intro: cat_cs_intros)
	show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTMap\<rparr> =
	(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r f d)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGDom\<rparr> = \<CC>"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	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 \<mapsto>\<^bsub>\<CC>\<^esub> s"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTMap\<rparr> =
	(\<lambda>d\<in>\<^sub>\<circ>op_cat \<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r f d)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDGDom\<rparr> = op_cat \<CC>"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	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\<open>Alternative definition.\<close>

	lemma (in category) ntcf_Hom_snd_def':
	assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = Yoneda_arrow \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<mapsto>\<^bsub>\<CC>\<^esub> s"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) = Yoneda_arrow \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,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\<open>Natural transformation map\<close>

	context category
	begin

	context
	fixes s r f
	assumes f: "f : s \<mapsto>\<^bsub>\<CC>\<^esub> 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 \<mapsto>\<^bsub>\<CC>\<^esub> 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\<open>
	\<open>Hom\<close>-natural transformation projections are natural transformations
	\<close>

	lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
	assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	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 \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	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 \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and "\<beta> = \<alpha>"
	and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	and "\<CC>' = \<CC>"
	and "\<DD>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
	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 \<mapsto>\<^bsub>\<CC>\<^esub> s"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	from assms have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 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 \<mapsto>\<^bsub>\<CC>\<^esub> s"
	and "\<beta> = \<alpha>"
	and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r)"
	and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)"
	and "\<CC>' = op_cat \<CC>"
	and "\<DD>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
	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\<open>Opposite \<open>Hom\<close>-natural transformation projections\<close>

	lemma (in category) cat_op_cat_ntcf_Hom_snd:
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,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\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(-,f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
	unfolding ntcf_Hom_fst_def cat_op_simps by simp

	lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst


	subsubsection\<open>
	\<open>Hom\<close>-natural transformation projections and the Yoneda component
	\<close>

	lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows
	"Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) c g d =
	Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d"
	(is \<open>?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d = ?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<close>)
	proof-

	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> 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 \<CC> b d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> 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 \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> 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 \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a d"
	by (auto intro: cat_cs_intros)
	from assms category_axioms have Y_gf:
	"?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a d"
	by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
	from Yf_Yg have dom_rhs:
	"\<D>\<^sub>\<circ> ((?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from Y_gf have dom_lhs: "\<D>\<^sub>\<circ> (?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
	by (cs_concl cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from Yf_Yg show arr_Set_Yf_Yg:
	"arr_Set \<alpha> (?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)"
	by (auto dest: cat_Set_is_arrD(1))
	interpret Yf_Yg: arr_Set \<alpha> \<open>?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d\<close>
	by (rule arr_Set_Yf_Yg)
	from Y_gf show arr_Set_Y_gf: "arr_Set \<alpha> (?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d)"
	by (auto dest: cat_Set_is_arrD(1))
	interpret Yf_Yg: arr_Set \<alpha> \<open>?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<close> by (rule arr_Set_Y_gf)
	show
	"(?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr> =
	?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
	with Y_gf Y_g Y_f category_axioms assms show
	"(?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> =
	?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	(slow)
	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 \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows
	"Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) d =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>"
	(is \<open>?Ycd = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<close>)
	proof-

	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)

	from assms category_axioms have Y_CId_c:
	"?Ycd : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> 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 \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr> : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> c d"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from Y_CId_c have dom_lhs: "\<D>\<^sub>\<circ> (?Ycd\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
	by (cs_concl cs_simp: cat_cs_simps)
	from CId_cd have dom_rhs: "\<D>\<^sub>\<circ> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from Y_CId_c show arr_Set_Y_CId_c: "arr_Set \<alpha> ?Ycd"
	by (auto dest: cat_Set_is_arrD(1))
	interpret Yf_Yg: arr_Set \<alpha> ?Ycd by (rule arr_Set_Y_CId_c)
	from CId_cd show arr_Set_CId_cd: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	interpret CId_cd: arr_Set \<alpha> \<open>cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<close>
	by (rule arr_Set_CId_cd)
	show "?Ycd\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
	with CId_cd Y_CId_c category_axioms assms show
	"?Ycd\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	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 \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed

	lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId


	subsubsection\<open>\<open>Hom\<close>-natural transformation projection of a composition\<close>

	lemma (in category) cat_ntcf_Hom_snd_Comp:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-)"
	(is \<open>?H_gf = ?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g\<close>)
	proof(rule ntcf_eqI[of \<alpha>])
	from assms category_axioms show
	"?H_gf : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms show "?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms have lhs_dom: "\<D>\<^sub>\<circ> (?H_gf\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms have rhs_dom:
	"\<D>\<^sub>\<circ> ((?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "?H_gf\<lparr>NTMap\<rparr> = (?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
	fix d assume "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms category_axioms show
	"?H_gf\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = (?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (use assms in \<open>auto intro: cat_cs_intros\<close>)
	qed auto

	lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp

	lemma (in category) cat_ntcf_Hom_fst_Comp:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,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\<open>\<open>Hom\<close>-natural transformation projection of an identity\<close>

	lemma (in category) cat_ntcf_Hom_snd_CId:
	assumes "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)"
	(is \<open>?H_c = ?id_H_c\<close>)
	proof(rule ntcf_eqI[of \<alpha>])
	from assms have "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c" by (auto simp: cat_cs_intros)
	from assms category_axioms show
	"?H_c : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms show
	"?id_H_c : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms have lhs_dom: "\<D>\<^sub>\<circ> (?H_c\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms category_axioms have rhs_dom: "\<D>\<^sub>\<circ> (?id_H_c\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "?H_c\<lparr>NTMap\<rparr> = ?id_H_c\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
	from assms category_axioms show "vsv (?id_H_c\<lparr>NTMap\<rparr>)"
	by (intro is_functor.ntcf_id_NTMap_vsv)
	(cs_concl cs_shallow cs_simp: cs_intro: cat_cs_intros)
	fix d assume "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms category_axioms show "?H_c\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = ?id_H_c\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	qed (use assms in \<open>auto intro: cat_cs_intros\<close>)
	qed auto

	lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId

	lemma (in category) cat_ntcf_Hom_fst_CId:
	assumes "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,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\<open>\<open>Hom\<close>-natural transformation and the Yoneda map\<close>

	lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
	assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	shows "Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr> = f"
	using category_axioms assms (slow)
	by
	(
	cs_concl
	- cs_simp: cat_cs_simps cat_op_simps
	+ 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 \<mapsto>\<^bsub>\<CC>\<^esub> s"
	shows "Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<rparr> = 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\<open>Evaluation arrow\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	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}.
	\<close>

	definition cf_eval_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_eval_arrow \<CC> \<NN> f =
	[
	(
	\<lambda>x\<in>\<^sub>\<circ>\<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>.
	\<NN>\<lparr>NTCod\<rparr>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>
	),
	\<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>,
	\<NN>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_eval_arrow_components:
	shows "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrVal\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>.
	\<NN>\<lparr>NTCod\<rparr>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>
	)"
	and "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>"
	and "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<NN> \<CC> \<FF> \<GG> a b f
	assumes \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	begin

	interpretation \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule \<NN>)

	lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
	where \<CC>=\<CC> and \<NN>=\<open>ntcf_arrow \<NN>\<close> and f=f,
	unfolded
	ntcf_arrow_components
	cf_map_components
	\<NN>.NTDom.HomDom.cat_is_arrD[OF f]
	cat_cs_simps
	]

	lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)

	end


	subsubsection\<open>Arrow value\<close>

	context
	fixes \<alpha> \<NN> \<CC> \<FF> \<GG> a b f
	assumes \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	begin

	mk_VLambda cf_eval_arrow_components'(1)[OF \<NN> 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\<open>Evaluation arrow is an arrow in the category \<open>Set\<close>\<close>

	lemma cf_eval_arrow_is_arr:
	assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	proof-
	interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> 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 \<CC> (ntcf_arrow \<NN>) f)"
	unfolding cf_eval_arrow_def by simp
	show "vcard (cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f) = 3\<^sub>\<nat>"
	unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	unfold cf_eval_arrow_components'[OF assms],
	intro vrange_VLambda_vsubset
	)
	(
	use assms in
	\<open>cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros\<close>
	)+
	qed
	(
	use assms(2) in
	\<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	)+
	qed

	lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
	assumes "\<NN>' = ntcf_arrow \<NN>"
	and "\<FF>a = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<GG>b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "cf_eval_arrow \<CC> \<NN>' f : \<FF>a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<GG>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 "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows
	"cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) =
	cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f"
	proof-

	interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> \<HH> \<MM> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(2))

	have \<MM>\<NN>: "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3,4) have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from \<MM>\<NN> gf have cf_eval_gf:
	"cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	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 \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	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 \<alpha> \<open>cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<close>
	by (rule cf_eval_gf(2))
	interpret arr_Set_cf_eval_g_cf_eval_f:
	arr_Set
	\<alpha>
	\<open>
	cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
	\<close>
	by (rule cf_eval_g_cf_eval_f(2))

	show ?thesis
	proof(rule arr_Set_eqI)
	from \<MM>\<NN> gf have dom_lhs:
	"\<D>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr>) =
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from cf_eval_g_cf_eval_f(1) have dom_rhs:
	"\<D>\<^sub>\<circ>
	(
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
	)\<lparr>ArrVal\<rparr>
	) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show
	"cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr> =
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
	)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix \<FF>a assume prems: "\<FF>a \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	from
	ArrVal_eq_helper
	[
	OF \<MM>.ntcf_Comp_commute[OF assms(4), symmetric],
	where a=\<open>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<close>
	]
	prems
	assms(3,4)
	have [cat_cs_simps]:
	"\<HH>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<rparr>\<rparr> =
	\<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<rparr>\<rparr>"
	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 \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr> =
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
	)\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>"
	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 "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows
	"cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms)

	from assms(2) have ntcf_id_CId_c:
	"cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros)
	from assms(2) have CId_\<FF>c:
	"cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])

	from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
	"arr_Set \<alpha> (cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>))"
	by (auto dest: cat_Set_is_arrD(1))
	from ntcf_id_CId_c have dom_lhs:
	"\<D>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr>) =
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)+
	interpret ntcf_id_CId_c:
	arr_Set \<alpha> \<open>cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<close>
	by (rule arr_Set_ntcf_id_CId_c)

	from CId_\<FF>c show arr_Set_CId_\<FF>c: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	from CId_\<FF>c assms(2) have dom_rhs:
	"\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>ArrVal\<rparr>) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show
	"cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	with category_axioms assms(2) show
	"cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_\<FF>c in auto)

	qed (use ntcf_id_CId_c CId_\<FF>c in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+

	qed

	lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id



	subsection\<open>\<open>HOM\<close>-functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following definition is a technical generalization that is used
	later in this section.
	\<close>

	definition cf_HOM_snd :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>HOM\<^sub>C\<index>'(/,_-/')\<close>)
	where "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) =
	[
	(\<lambda>a\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(a,-) \<circ>\<^sub>C\<^sub>F \<FF>)),
	(
	\<lambda>f\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)
	),
	op_cat (\<FF>\<lparr>HomCod\<rparr>),
	cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)
	]\<^sub>\<circ>"

	definition cf_HOM_fst :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>HOM\<^sub>C\<index>'(/_-,/')\<close>)
	where "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) =
	[
	(\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<FF>)),
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<FF>)
	),
	\<FF>\<lparr>HomCod\<rparr>,
	cat_FUNCT \<alpha> (op_cat (\<FF>\<lparr>HomDom\<rparr>)) (cat_Set \<alpha>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_HOM_snd_components:
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(a,-) \<circ>\<^sub>C\<^sub>F \<FF>))"
	and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)
	)"
	and [cat_cs_simps]: "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomCod\<rparr>)"
	and [cat_cs_simps]:
	"HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)"
	unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)

	lemma cf_HOM_fst_components:
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ObjMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<FF>))"
	and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<FF>)
	)"
	and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> (op_cat (\<FF>\<lparr>HomDom\<rparr>)) (cat_Set \<alpha>)"
	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 \<FF>=\<FF>, 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 \<FF>=\<FF>, unfolded cf_HomDom cf_HomCod]

	lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)

	end


	subsubsection\<open>Object map\<close>

	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\<open>Arrow map\<close>

	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\<open>Opposite \<open>HOM\<close>-functor\<close>

	lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]:
	"HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-) = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)"
	proof-
	have dom_lhs: "\<D>\<^sub>\<circ> HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-) = 4\<^sub>\<nat>"
	unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) = 4\<^sub>\<nat>"
	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 \<in>\<^sub>\<circ> 4\<^sub>\<nat>"
	then show "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>a\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>a\<rparr>"
	proof
	(
	elim_in_numeral,
	use nothing in \<open>fold dghm_field_simps, unfold cat_cs_simps\<close>
	)
	show "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>ObjMap\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ObjMap\<rparr>"
	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\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>ArrMap\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ArrMap\<rparr>"
	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\<open>\<open>HOM\<close>-functor is a functor\<close>

	lemma (in is_functor) cf_HOM_snd_is_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<CC>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+

	show ?thesis
	proof(intro is_functorI', unfold cat_op_simps)
	show "vfsequence HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)" unfolding cf_HOM_snd_def by auto
	show "vcard HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) = 4\<^sub>\<nat>"
	unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
	unfolding cf_HOM_snd_components'
	proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
	fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	with assms(2) show
	"cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(b,-) \<circ>\<^sub>C\<^sub>F \<FF>) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	show
	"HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g\<rparr> =
	HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<^esub>
	HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : c \<mapsto>\<^bsub>\<BB>\<^esub> b" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> 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\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>CId\<rparr>\<lparr>HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 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
	\<open>
	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
	\<close>
	)+

	qed

	lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<CC>' = op_cat \<BB>"
	and "\<DD> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)"
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>"
	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 "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> (op_cat \<AA>) (cat_Set \<alpha>)"
	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<CC>' = \<BB>"
	and "\<DD> = cat_FUNCT \<alpha> (op_cat \<AA>) (cat_Set \<alpha>)"
	shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>"
	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\<open>Evaluation functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_eval :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_eval \<alpha> \<beta> \<CC> =
	[
	(\<lambda>\<FF>d\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<FF>d\<lparr>0\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<FF>d\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>),
	(
	\<lambda>\<NN>f\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
	cf_eval_arrow \<CC> (\<NN>f\<lparr>0\<rparr>) (\<NN>f\<lparr>1\<^sub>\<nat>\<rparr>)
	),
	cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>,
	cat_Set \<beta>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_eval_components:
	shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr> =
	(\<lambda>\<FF>d\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<FF>d\<lparr>0\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<FF>d\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>)"
	and "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>\<NN>f\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
	cf_eval_arrow \<CC> (\<NN>f\<lparr>0\<rparr>) (\<NN>f\<lparr>1\<^sub>\<nat>\<rparr>)
	)"
	and [cat_cs_simps]:
	"cf_eval \<alpha> \<beta> \<CC>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
	and [cat_cs_simps]: "cf_eval \<alpha> \<beta> \<CC>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>)"
	unfolding cf_eval_components by simp

	lemma cf_eval_ObjMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>) = (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	unfolding cf_eval_components by simp

	lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]:
	assumes "\<FF>c = [cf_map \<FF>, c]\<^sub>\<circ>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" (the order of premises is important)
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(2))
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp
	note [cat_small_cs_intros] = cat_category_if_ge_Limit
	from assms(2,3) \<alpha>\<beta> have "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	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\<open>Arrow map\<close>

	lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>)"
	unfolding cf_eval_components by simp

	lemma cf_eval_ArrMap_vdomain[cat_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>) = (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	unfolding cf_eval_components by simp

	lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]:
	assumes "\<NN>f = [ntcf_arrow \<NN>, f]\<^sub>\<circ>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> = cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f"
	proof-
	interpret \<FF>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(2))
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp
	note [cat_small_cs_intros] = cat_category_if_ge_Limit
	from assms(1,3) \<alpha>\<beta> have "\<NN>f \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
	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\<open>Evaluation functor is a functor\<close>

	lemma (in category) cat_cf_eval_is_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_eval \<alpha> \<beta> \<CC> : cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT:
	category \<beta> \<open>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))\<close>
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	interpret \<beta>\<CC>: category \<beta> \<CC>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
	by (rule subcategory_cat_Set_cat_Set[OF assms])

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (cf_eval \<alpha> \<beta> \<CC>)" unfolding cf_eval_def by simp
	from cat_category_if_ge_Limit[OF assms] show
	"category \<beta> ((cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) \<times>\<^sub>C \<CC>)"
	by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
	show "vcard (cf_eval \<alpha> \<beta> \<CC>) = 4\<^sub>\<nat>"
	unfolding cf_eval_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
	fix \<FF>c assume prems: "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	then obtain \<FF> c
	where \<FF>c_def: "\<FF>c = [\<FF>, c]\<^sub>\<circ>"
	and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by
	(
	auto
	elim: cat_prod_2_ObjE[rotated 2]
	intro: FUNCT.category_axioms \<beta>\<CC>.category_axioms
	simp: cat_FUNCT_components(1)
	)
	from \<FF> obtain \<GG> where \<FF>_def: "\<FF> = cf_map \<GG>"
	and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (elim cf_mapsE)
	interpret \<GG>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> by (rule \<GG>)
	from \<GG> c show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	unfolding \<FF>c_def \<FF>_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_Set_\<alpha>\<beta>.subcat_Obj_vsubset
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> :
	cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr>"
	if \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b" for \<FF>a \<GG>b \<NN>f
	proof-
	obtain \<NN> f \<FF> a \<GG> b
	where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>"
	and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
	and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>"
	and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	auto intro:
	cat_prod_2_is_arrE[rotated 2, OF \<NN>f]
	FUNCT.category_axioms
	\<beta>\<CC>.category_axioms
	)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	from \<NN>(1) f assms(2) show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> :
	cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr>"
	unfolding \<NN>f_def \<FF>a_def \<GG>b_def
	by
	(
	intro cat_Set_\<alpha>\<beta>.subcat_is_arrD,
	use nothing in \<open>subst \<NN>(2), subst \<NN>(3), subst \<NN>(4)\<close>
	)
	(
	cs_concl
	cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	) (slow)
	qed
	show
	"cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<NN>f\<rparr> =
	cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr>"
	if \<MM>g: "\<MM>g : \<GG>b \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<HH>c"
	and \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b"
	for \<NN>f \<MM>g \<FF>a \<GG>b \<HH>c
	proof-
	obtain \<NN> f \<FF> a \<GG> b
	where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>"
	and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
	and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>"
	and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	auto intro:
	cat_prod_2_is_arrE[rotated 2, OF \<NN>f]
	FUNCT.category_axioms
	\<beta>\<CC>.category_axioms
	)
	then obtain \<MM> g \<HH> c
	where \<MM>g_def: "\<MM>g = [\<MM>, g]\<^sub>\<circ>"
	and \<HH>c_def: "\<HH>c = [\<HH>, c]\<^sub>\<circ>"
	and \<MM>: "\<MM> : \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<HH>"
	and g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by
	(
	auto intro:
	cat_prod_2_is_arrE[rotated 2, OF \<MM>g]
	FUNCT.category_axioms
	\<beta>\<CC>.category_axioms
	)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	and \<MM> = cat_FUNCT_is_arrD[OF \<MM>]
	from \<NN>(1) \<MM>(1) f g show
	"cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<NN>f\<rparr> =
	cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr>"
	unfolding \<MM>g_def \<NN>f_def \<FF>a_def \<GG>b_def \<HH>c_def
	by
	(
	subst (1 2) \<MM>(2), use nothing in \<open>subst (1 2) \<NN>(2)\<close>,
	cs_concl_step cs_shallow cat_Set_\<alpha>\<beta>.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 \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>c\<rparr>\<rparr> =
	cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr>\<rparr>"
	if "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>c
	proof-
	from that obtain \<FF> c where \<FF>c_def: "\<FF>c = [\<FF>, c]\<^sub>\<circ>"
	and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by
	(
	auto
	elim: cat_prod_2_ObjE[rotated 2]
	intro: FUNCT.category_axioms \<beta>\<CC>.category_axioms
	simp: cat_FUNCT_components(1)
	)
	from \<FF> obtain \<GG> where \<FF>_def: "\<FF> = cf_map \<GG>"
	and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (elim cf_mapsE)
	interpret \<GG>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> by (rule \<GG>)
	from \<GG> c show
	"cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>c\<rparr>\<rparr> =
	cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr>\<rparr>"
	unfolding \<FF>c_def \<FF>_def
	by (cs_concl_step cat_Set_\<alpha>\<beta>.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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<AA>' = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
	and "\<BB>' = cat_Set \<beta>"
	and "\<beta>' = \<beta>"
	shows "cf_eval \<alpha> \<beta> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
	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\<open>\<open>N\<close>-functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_nt :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_nt \<alpha> \<beta> \<FF> =
	bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))"


	text\<open>Alternative definition.\<close>

	lemma (in is_functor) cf_nt_def':
	"cf_nt \<alpha> \<beta> \<FF> =
	bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))"
	unfolding cf_nt_def cf_HomDom cf_HomCod by simp


	text\<open>Components.\<close>

	lemma cf_nt_components:
	shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
	(
	bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ObjMap\<rparr>"
	and "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
	(
	bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ArrMap\<rparr>"
	and "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> =
	(
	bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>HomDom\<rparr>"
	and "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> =
	(
	bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>HomCod\<rparr>"
	unfolding cf_nt_def by simp_all

	lemma (in is_functor) cf_nt_components':
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
	(
	bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ObjMap\<rparr>"
	and "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
	(
	bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ArrMap\<rparr>"
	and [cat_cs_simps]:
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
	and [cat_cs_simps]:
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	show
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
	(
	bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ObjMap\<rparr>"
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
	(
	bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
	)\<lparr>ArrMap\<rparr>"
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
	"cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	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\<open>Object map\<close>

	lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>)"
	unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

	lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<D>\<^sub>\<circ> (cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<GG>b = [cf_map \<GG>, b]\<^sub>\<circ>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr> = Hom
	(cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(b,-) \<circ>\<^sub>C\<^sub>F \<FF>))
	(cf_map \<GG>)"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<GG>: is_functor \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<GG> 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\<open>Arrow map\<close>

	lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>)"
	unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

	lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<D>\<^sub>\<circ> (cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN>f = [ntcf_arrow \<NN>, f]\<^sub>\<circ>"
	and "\<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> = cf_hom
	(cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
	[ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>), ntcf_arrow \<NN>]\<^sub>\<circ>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<NN>: is_ntcf \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<GG> \<HH> \<NN> 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\<open>\<open>N\<close>-functor is a functor\<close>

	lemma (in is_functor) cf_nt_is_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "cf_nt \<alpha> \<beta> \<FF> : cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<AA>: category \<beta> \<AA>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: category \<beta> \<BB>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<AA>' = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
	and "\<BB>' = cat_Set \<beta>"
	and "\<beta>' = \<beta>"
	shows "cf_nt \<alpha> \<beta> \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
	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\<open>Yoneda natural transformation arrow\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following subsection is based on the elements of the content
	of Chapter III-2 in \cite{mac_lane_categories_2010}.
	\<close>

	definition ntcf_Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r =
	[
	(
	\<lambda>\<psi>\<in>\<^sub>\<circ>Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>.
	Yoneda_map \<alpha> (cf_of_cf_map \<CC> (cat_Set \<alpha>) \<FF>) r\<lparr>
	ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<psi>
	\<rparr>
	),
	Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>,
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components\<close>

	lemma ntcf_Yoneda_arrow_components:
	shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrVal\<rparr> =
	(
	\<lambda>\<psi>\<in>\<^sub>\<circ>Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>.
	Yoneda_map \<alpha> (cf_of_cf_map \<CC> (cat_Set \<alpha>) \<FF>) r\<lparr>
	ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<psi>
	\<rparr>
	)"
	and [cat_cs_simps]: "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrDom\<rparr> =
	Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>"
	and [cat_cs_simps]: "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrCod\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	unfolding ntcf_Yoneda_arrow_def arr_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow map\<close>

	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 \<FF> :: V
	begin

	mk_VLambda ntcf_Yoneda_arrow_components(1)[where \<alpha>=\<alpha> and \<CC>=\<CC> and \<FF>=\<open>cf_map \<FF>\<close>]
	\|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\<open>Several technical lemmas\<close>

	lemma (in vsv) vsv_vrange_VLambda_app:
	assumes "g ` elts A = elts (\<D>\<^sub>\<circ> r)"
	shows "\<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>) = \<R>\<^sub>\<circ> r"
	proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
	show "(\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" if "x \<in>\<^sub>\<circ> A" for x
	proof-
	from assms that have "g x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
	then have "r\<lparr>g x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by force
	with that show ?thesis by simp
	qed
	show "r\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)" if "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" for x
	proof-
	from that assms have "x \<in> g ` elts A" by simp
	then obtain c where c: "c \<in>\<^sub>\<circ> 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 (\<D>\<^sub>\<circ> r)"
	and "R = \<R>\<^sub>\<circ> r"
	shows "\<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>) = 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 (\<D>\<^sub>\<circ> r))"
	shows "v11 (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)"
	proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
	fix x y assume prems: "x \<in>\<^sub>\<circ> A" "y \<in>\<^sub>\<circ> A" "r\<lparr>g x\<rparr> = r\<lparr>g y\<rparr>"
	from assms prems(1,2) have "g x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "g y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> 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\<open>
	Yoneda natural transformation arrow is an arrow in the category \<open>Set\<close>
	\<close>

	lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r :
	Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
	(cf_map \<FF>) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub>
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms)

	from assms(2) interpret FUNCT: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	let ?Hom_r = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close>

	from assms have [cat_cs_simps]: "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map \<FF>) = \<FF>"
	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_arr_isomorphismI cat_Set_is_arrI arr_SetI,
	+ intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI,
	unfold cat_cs_simps cf_map_components
	)
	show "vfsequence (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r)"
	unfolding ntcf_Yoneda_arrow_def by simp
	show "vcard (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r) = 3\<^sub>\<nat>"
	unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	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
	\<open>
	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
	\<close>
	)+
	then show "\<R>\<^sub>\<circ> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by auto
	from assms(4) show "v11 (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>)"
	unfolding ntcf_Yoneda_arrow_components
	by
	(
	intro v11.v11_VLambda_v11_bij_betw_comp,
	unfold cat_cs_simps \<FF>.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 \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map ?Hom_r) (cf_map \<FF>) \<in>\<^sub>\<circ> Vset \<beta>"
	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 "\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros)
	then show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<FF>' = cf_map \<FF>"
	and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "A = Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
	(cf_map \<FF>)"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF>' r : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> 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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r :
	Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
	(cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by
	(
	- rule cat_Set_is_arr_isomorphismD[
	+ 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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<FF>' = cf_map \<FF>"
	and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "A = Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
	(cf_map \<FF>)"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF>' r : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> 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\<open>Commutativity law for the Yoneda natural transformation arrow\<close>

	-lemma (in category) cat_ntcf_Yoneda_arrow_commutativity:
	+lemma (in category) cat_ntcf_Yoneda_arrow_commute:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows
	"ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	cf_hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	[ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-), ntcf_arrow \<NN>]\<^sub>\<circ> =
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a"
	proof-

	let ?hom =
	\<open>
	cf_hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	[ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-), ntcf_arrow \<NN>]\<^sub>\<circ>
	\<close>

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(3))
	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	interpret \<beta>\<CC>: category \<beta> \<CC>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
	by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])

	from assms(2,4) have \<GG>b_\<NN>f:
	"ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom :
	Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
	(cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	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 \<NN>f_\<FF>a:
	"cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a :
	Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
	(cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros cat_Set_\<alpha>\<beta>.subcat_is_arrD)

	show ?thesis
	proof(rule arr_Set_eqI[of \<beta>])

	from \<GG>b_\<NN>f show arr_Set_\<GG>b_\<NN>f:
	"arr_Set \<beta> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)"
	by (auto dest: cat_Set_is_arrD(1))
	from \<GG>b_\<NN>f have dom_lhs:
	"\<D>\<^sub>\<circ> ((ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr>) =
	Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
	(cf_map \<FF>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	interpret \<NN>f_\<FF>a: arr_Set
	\<beta> \<open>ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom\<close>
	by (rule arr_Set_\<GG>b_\<NN>f)

	from \<NN>f_\<FF>a show arr_Set_\<NN>f_\<FF>a:
	"arr_Set
	\<beta>
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
	)"
	by (auto dest: cat_Set_is_arrD(1))
	from \<NN>f_\<FF>a have dom_rhs:
	"\<D>\<^sub>\<circ>
	(
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
	)\<lparr>ArrVal\<rparr>
	) = Hom
	(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
	(cf_map \<FF>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show
	"(ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr> =
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
	)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)

	fix \<MM> assume prems:
	"\<MM> : cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> cf_map \<FF>"

	from assms(4) have [cat_cs_simps]:
	"cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
	"cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map \<FF>) = \<FF>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)

	note \<MM> = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]

	interpret \<MM>: is_ntcf
	\<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)\<close> \<FF> \<open>ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<MM>\<close>
	by (rule \<MM>(1))

	have \<GG>\<NN>_eq_\<NN>\<FF>:
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>A\<rparr>\<rparr> =
	\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>A\<rparr>\<rparr>"
	if "A \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" for A
	using
	ArrVal_eq_helper[
	OF \<NN>.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 \<MM>(1) assms(2,3,4) have \<MM>a_CId_a:
	"\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (subst \<MM>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
	cs_intro: cat_Set_cs_intros cat_cs_intros
	)

	have \<FF>f_\<MM>a_eq_\<MM>b:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>\<rparr> =
	\<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h\<rparr>"
	if "h : a \<mapsto>\<^bsub>\<CC>\<^esub> a" for h
	using
	ArrVal_eq_helper[
	OF \<MM>.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_cs_simps cat_op_simps
	+ 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 \<MM>(1) assms(2,3,4) \<MM>a_CId_a category_axioms show
	"(ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<rparr> =
	(
	cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
	)\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<rparr>"
	by (subst (1 2) \<MM>(2)) (very slow)
	(
	cs_concl
	cs_simp:
	\<FF>f_\<MM>a_eq_\<MM>b \<GG>\<NN>_eq_\<NN>\<FF>
	+ cat_map_extra_cs_simps
	cat_FUNCT_cs_simps
	cat_cs_simps
	cat_op_simps
	+ cat_Set_components(1)
	cs_intro:
	cat_Set_\<alpha>\<beta>.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_\<GG>b_\<NN>f arr_Set_\<NN>f_\<FF>a in auto)

	qed (use \<GG>b_\<NN>f \<NN>f_\<FF>a in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed



	subsection\<open>Yoneda Lemma: naturality\<close>


	subsubsection\<open>
	The Yoneda natural transformation: definition and elementary properties
	\<close>


	text\<open>
	The main result of this subsection corresponds to the corollary to the
	Yoneda Lemma on page 61 in \cite{mac_lane_categories_2010}.
	\<close>

	definition ntcf_Yoneda :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_Yoneda \<alpha> \<beta> \<CC> =
	[
	(
	\<lambda>\<FF>r\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>.
	ntcf_Yoneda_arrow \<alpha> \<CC> (\<FF>r\<lparr>0\<rparr>) (\<FF>r\<lparr>1\<^sub>\<nat>\<rparr>)
	),
	cf_nt \<alpha> \<beta> (cf_id \<CC>),
	cf_eval \<alpha> \<beta> \<CC>,
	cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>,
	cat_Set \<beta>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma ntcf_Yoneda_components:
	shows "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr> =
	(
	\<lambda>\<FF>r\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>.
	ntcf_Yoneda_arrow \<alpha> \<CC> (\<FF>r\<lparr>0\<rparr>) (\<FF>r\<lparr>1\<^sub>\<nat>\<rparr>)
	)"
	and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDom\<rparr> = cf_nt \<alpha> \<beta> (cf_id \<CC>)"
	and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTCod\<rparr> = cf_eval \<alpha> \<beta> \<CC>"
	and [cat_cs_simps]:
	"ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDGDom\<rparr> = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
	and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
	unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	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 "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<FF>r = [cf_map \<FF>, r]\<^sub>\<circ>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> = ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(4))
	interpret \<beta>\<CC>: category \<beta> \<CC>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	from assms(2) interpret FUNCT: category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	)
	from assms(5) have "[cf_map \<FF>, r]\<^sub>\<circ> \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	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\<open>The Yoneda natural transformation is a natural transformation\<close>

	lemma (in category) cat_ntcf_Yoneda_is_ntcf:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "ntcf_Yoneda \<alpha> \<beta> \<CC> :
	cf_nt \<alpha> \<beta> (cf_id \<CC>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_eval \<alpha> \<beta> \<CC> :
	cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<beta>\<CC>: category \<beta> \<CC>
	by (rule category.cat_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	from assms(2) interpret FUNCT: category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
	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 \<alpha> \<beta> \<CC>)" unfolding ntcf_Yoneda_def by simp
	show "vcard (ntcf_Yoneda \<alpha> \<beta> \<CC>) = 5\<^sub>\<nat>"
	unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
	show ntcf_Yoneda_\<FF>r: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> :
	cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr>"
	if "\<FF>r \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>r
	proof-
	from that obtain \<FF> r
	where \<FF>r_def: "\<FF>r = [\<FF>, r]\<^sub>\<circ>"
	and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
	and r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by
	(
	auto
	elim: cat_prod_2_ObjE[rotated 2]
	simp: cat_FUNCT_cs_simps
	intro: cat_cs_intros
	)
	from \<FF> obtain \<GG>
	where \<FF>_def: "\<FF> = cf_map \<GG>" and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by clarsimp
	from assms(2) \<GG> r show ?thesis
	unfolding \<FF>r_def \<FF>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	qed
	show "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> :
	cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr>"
	if "\<FF>r \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>r
	- by (rule is_arr_isomorphismD[OF ntcf_Yoneda_\<FF>r[OF that]])
	+ by (rule is_iso_arrD[OF ntcf_Yoneda_\<FF>r[OF that]])
	show
	"ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<GG>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> =
	cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>a\<rparr>"
	if \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b" for \<FF>a \<GG>b \<NN>f
	proof-
	obtain \<NN> f \<FF> a \<GG> b
	where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>"
	and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
	and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>"
	and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	auto intro:
	cat_prod_2_is_arrE[rotated 2, OF \<NN>f]
	FUNCT.category_axioms
	\<beta>\<CC>.category_axioms
	)
	note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
	note [cat_cs_simps] =
	- cat_ntcf_Yoneda_arrow_commutativity[OF assms \<NN>(1) f, folded \<NN>(2,3,4)]
	+ cat_ntcf_Yoneda_arrow_commute[OF assms \<NN>(1) f, folded \<NN>(2,3,4)]
	from \<NN>(1) assms(2) f show ?thesis
	unfolding \<NN>f_def \<FF>a_def \<GG>b_def
	by (subst (1 2) \<NN>(2), use nothing in \<open>subst \<NN>(3), subst \<NN>(4)\<close>)
	(
	cs_concl
	cs_simp: \<NN>(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
	)+
	qed

	qed (use assms(2) in \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>)+

	qed



	subsection\<open>\<open>Hom\<close>-map\<close>

	text\<open>
	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.
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following function makes an explicit appearance in subsection 1.15 in
	\cite{bodo_categories_1970}.
	\<close>

	definition ntcf_Hom_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_Hom_map \<alpha> \<CC> a b = (\<lambda>f\<in>\<^sub>\<circ>Hom \<CC> a b. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-))"


	text\<open>Elementary properties.\<close>

	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\<open>\<open>Hom\<close>-map is a bijection\<close>

	lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
	\<comment>\<open>The following lemma approximately corresponds to the corollary on
	page 61 in \cite{mac_lane_categories_2010}.\<close>
	assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
	and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
	f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
	proof-

	interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<close> \<NN>
	by (rule assms(3))
	let ?Y_Hom_s = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<close>
	note Yoneda =
	cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
	interpret Y: v11 \<open>?Y_Hom_s\<close> by (rule Yoneda(1))

	from category_axioms assms have \<NN>_in_vdomain: "\<NN> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (?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\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
	from this category_axioms assms show Ym_\<NN>: "?Y_Hom_s\<lparr>\<NN>\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	unfolding Yoneda(2)
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cat_op_simps)
	then have "?Y_Hom_s\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by (simp add: cat_cs_intros)

	have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (intro cat_ntcf_Hom_snd_is_ntcf Ym_\<NN>)

	from assms Ym_\<NN> this category_axioms assms have
	"(?Y_Hom_s)\<inverse>\<^sub>\<circ>\<lparr>?Y_Hom_s\<lparr>\<NN>\<rparr>\<rparr> =
	Yoneda_arrow \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r (?Y_Hom_s\<lparr>\<NN>\<rparr>)"
	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)\<inverse>\<^sub>\<circ>\<lparr>?Y_Hom_s\<lparr>\<NN>\<rparr>\<rparr> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-)"
	by (simp add: ntcf_Hom_snd_def'[OF Ym_\<NN>])
	with \<NN>_in_vdomain show "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-)" by auto

	fix f assume prems: "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
	then obtain a b where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto

	have "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
	with f \<NN>.ntcf_NTDom \<NN>.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 \<mapsto>\<^bsub>\<CC>\<^esub> r" unfolding ba_simps .

	with category_axioms show "f = ?Y_Hom_s\<lparr>\<NN>\<rparr>"
	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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr> : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
	and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>)"
	and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) \<rbrakk> \<Longrightarrow>
	f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>"
	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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "\<exists>!f. f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "\<exists>!f. f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,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\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
	and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "g = f"
	proof-
	from assms have
	"Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) b\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-)\<rparr> =
	Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) b\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr>"
	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 (slow)
	qed

	lemma (in category) cat_ntcf_Hom_fst_inj:
	assumes "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)"
	and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> 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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "v11 (ntcf_Hom_map \<alpha> \<CC> a b)"
	and "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) =
	these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
	and "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ> =
	(\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>)"
	proof-

	show "v11 (ntcf_Hom_map \<alpha> \<CC> a b)"
	proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
	show "vsv (ntcf_Hom_map \<alpha> \<CC> a b)" unfolding ntcf_Hom_map_def by simp
	fix g f assume prems:
	"g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	"f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	"ntcf_Hom_map \<alpha> \<CC> a b\<lparr>g\<rparr> = ntcf_Hom_map \<alpha> \<CC> a b\<lparr>f\<rparr>"
	from prems(3,1,2) have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<open>ntcf_Hom_map \<alpha> \<CC> a b\<close> .

	show Hm_vrange: "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) =
	these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
	proof(intro vsubset_antisym)
	show "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) \<subseteq>\<^sub>\<circ>
	these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<subseteq>\<^sub>\<circ>
	\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b)"
	proof(intro vsubsetI, unfold these_ntcfs_iff)
	fix \<NN> assume prems:
	"\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	note unique =
	cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
	from unique(1) have
	"Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> 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 \<NN>_def: "\<NN> = ntcf_Hom_map \<alpha> \<CC> a b\<lparr>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	ultimately show "\<NN> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b)" by force
	qed
	qed

	show "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ> =
	(
	\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
	)"
	proof
	(
	rule vsv_eqI,
	unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
	)

	from Hm.v11_axioms show "vsv ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>)" by auto
	show "vsv
	(
	\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
	)"
	by simp

	fix \<NN> assume prems:
	"\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	then have \<NN>:
	"\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
	unfolding these_ntcfs_iff by simp
	show "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> =
	(
	\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
	)\<lparr>\<NN>\<rparr>"
	proof
	(
	intro Hm.v11_vconverse_app,
	unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF \<NN>]
	)
	note unique =
	cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
	show "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by (rule unique(1))
	then show
	"ntcf_Hom_map \<alpha> \<CC> a b\<lparr>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>\<rparr> = \<NN>"
	by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
	qed

	qed simp

	qed


	subsubsection\<open>Inverse of a \<open>Hom\<close>-map\<close>

	lemma (in category) inv_ntcf_Hom_map_v11:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "v11 ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>)"
	using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)

	lemma (in category) inv_ntcf_Hom_map_vdomain:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>) =
	these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>"
	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: "\<R>\<^sub>\<circ> ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>) = Hom \<CC> a b"
	unfolding ntcf_Hom_map_def by simp


	subsubsection\<open>\<open>Hom\<close>-natural transformation and isomorphisms\<close>


	text\<open>
	This subsection presents further results that were stated
	as Corollary 2 in subsection 1.15 in \cite{bodo_categories_1970}.
	\<close>

	-lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf:
	+lemma (in category) cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf:
	assumes "f : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	from assms obtain g
	where iso_g: "g : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
	and gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>"
	and fg: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
	by
	(
	auto intro:
	cat_the_inverse_Comp_CId_left
	cat_the_inverse_Comp_CId_right
	- cat_the_inverse_is_arr_isomorphism'
	+ cat_the_inverse_is_iso_arr'
	)
	then have g: "g : r \<mapsto>\<^bsub>\<CC>\<^esub> s" by auto
	show ?thesis
	- proof(intro is_arr_isomorphism_is_iso_ntcf)
	+ proof(intro is_iso_arr_is_iso_ntcf)
	from assms have f: "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
	with category_axioms show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from category_axioms g show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from category_axioms f g have
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from category_axioms f g have "\<dots> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
	finally show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	by simp
	from category_axioms f g have
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from category_axioms f g have "\<dots> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
	finally show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	by simp
	qed
	qed

	-lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_fst_is_iso_ntcf:
	+lemma (in category) cat_is_iso_arr_ntcf_Hom_fst_is_iso_ntcf:
	assumes "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	from assms have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	from
	- category.cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf
	+ 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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
	and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
	f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
	proof-

	let ?Ym_\<NN> = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>\<close>
	and ?Ym_inv_\<NN> = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) s\<lparr>inv_ntcf \<NN>\<rparr>\<close>

	from assms(3) have \<NN>:
	"\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by auto
	- from iso_ntcf_is_arr_isomorphism[OF assms(3)]
	+ from iso_ntcf_is_iso_arr[OF assms(3)]
	have iso_inv_\<NN>: "inv_ntcf \<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and [simp]: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	and [simp]: "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	by auto
	from iso_inv_\<NN> have inv_\<NN>:
	"inv_ntcf \<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by auto
	note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) \<NN>]
	and inv_unique =
	cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_\<NN>]
	have Ym_\<NN>: "?Ym_\<NN> : s \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule unique(1))

	show "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
	and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
	f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
	by (intro unique)+

	show "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	- proof(intro is_arr_isomorphismI[OF Ym_\<NN>, of \<open>?Ym_inv_\<NN>\<close>] is_inverseI)
	+ proof(intro is_iso_arrI[OF Ym_\<NN>, of \<open>?Ym_inv_\<NN>\<close>] is_inverseI)

	show Ym_inv_\<NN>: "?Ym_inv_\<NN> : r \<mapsto>\<^bsub>\<CC>\<^esub> s" by (rule inv_unique(1))

	have "ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>" by simp
	also have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN>,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN>,-)"
	by (subst unique(2), subst inv_unique(2)) simp
	also from category_axioms Ym_\<NN> inv_unique(1) assms(3) have
	"\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	finally have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
	by simp
	also from category_axioms assms(1,2) have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	finally have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>,-)"
	by simp
	then show "?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN> = \<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>"
	by (rule cat_ntcf_Hom_snd_inj)
	(
	all\<open>
	use category_axioms Ym_\<NN> Ym_inv_\<NN> assms in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	\<close>
	)
	have "ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) = inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>" by simp
	also have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN>,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN>,-)"
	by (subst unique(2), subst inv_unique(2)) simp
	also from category_axioms Ym_\<NN> inv_unique(1) have
	"\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	finally have
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
	by simp
	also from category_axioms assms(1,2) have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>,-)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	finally have
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>,-)"
	by simp
	then show "?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN> = \<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
	by (rule cat_ntcf_Hom_snd_inj)
	(
	all\<open>
	use category_axioms Ym_\<NN> Ym_inv_\<NN> assms in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	\<close>
	)

	qed (intro Ym_\<NN>)

	qed

	lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
	assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr> : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
	and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>)"
	and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) \<rbrakk> \<Longrightarrow>
	f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>"
	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_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf:
	+lemma (in category) cat_is_iso_arr_if_ntcf_Hom_snd_is_iso_ntcf:
	assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "f : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	proof-
	from assms(1) have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 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 \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> 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_arr_isomorphism_if_ntcf_Hom_fst_is_iso_ntcf:
	+lemma (in category) cat_is_iso_arr_if_ntcf_Hom_fst_is_iso_ntcf:
	assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
	proof-
	from assms(1) have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 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 \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<rparr> : r \<mapsto>\<^bsub>\<CC>\<^esub> 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\<open>
	The relationship between a \<open>Hom\<close>-natural transformation and the compositions
	of a \<open>Hom\<close>-natural transformation and a natural transformation
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	from assms(2) have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	show ?thesis
	proof(rule ntcf_eqI[of \<alpha>])
	from category_axioms assms show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	from assms this have dom_lhs:
	"\<D>\<^sub>\<circ> ((Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from category_axioms assms show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms this have dom_rhs:
	"\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show
	"(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> =
	Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with category_axioms assms show
	"(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	qed (use assms(2) in \<open>auto intro: cat_cs_intros\<close>)
	qed simp_all
	qed

	lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd


	subsubsection\<open>
	The relationship between the \<open>Hom\<close>-natural isomorphisms and the compositions
	of a \<open>Hom\<close>-natural isomorphism and a natural transformation
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 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 \<phi>.NTDom.is_functor_axioms that]
	cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.NTCod.is_functor_axioms that]
	by (intro assms(2) that)
	from
	is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
	OF
	\<phi>.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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> 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 \<phi>.NTDom.is_functor_axioms assms(3)]
	cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.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\<open>Yoneda map for arbitrary functors\<close>


	text\<open>
	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}.
	\<close>

	definition af_Yoneda_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "af_Yoneda_map \<alpha> \<FF> \<GG> =
	(\<lambda>\<phi>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>) \<FF> \<GG>. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-))"


	text\<open>Elementary properties.\<close>

	context
	fixes \<alpha> \<BB> \<CC> \<FF> \<GG>
	assumes \<FF>: "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<GG>: "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule \<FF>)
	interpretation \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule \<GG>)

	mk_VLambda
	af_Yoneda_map_def[where \<FF>=\<FF> and \<GG>=\<GG>, unfolded \<FF>.cf_HomDom \<FF>.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\<open>Yoneda arrow for arbitrary functors\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following natural transformation is used in the proof of Lemma 3 in
	subsection 1.15 in \cite{bodo_categories_1970}.
	\<close>

	definition af_Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> =
	[
	(
	\<lambda>b\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
	\<NN>\<^bsub>op_cat (\<FF>\<lparr>HomDom\<rparr>),\<FF>\<lparr>HomCod\<rparr>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	\<rparr>
	),
	\<FF>,
	\<GG>,
	\<FF>\<lparr>HomDom\<rparr>,
	\<FF>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma af_Yoneda_arrow_components:
	shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr> =
	(
	\<lambda>b\<in>\<^sub>\<circ>\<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
	Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
	\<NN>\<^bsub>op_cat (\<FF>\<lparr>HomDom\<rparr>),\<FF>\<lparr>HomCod\<rparr>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	\<rparr>
	)"
	and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDom\<rparr> = \<FF>"
	and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTCod\<rparr> = \<GG>"
	and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDGDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDGCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda af_Yoneda_arrow_components(1)
	\|vsv af_Yoneda_arrow_NTMap_vsv\|

	context
	fixes \<alpha> \<BB> \<CC> \<FF>
	assumes \<FF>: "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule \<FF>)

	mk_VLambda
	af_Yoneda_arrow_components(1)[where \<FF>=\<FF>, unfolded \<FF>.cf_HomDom \<FF>.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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
	and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
	and ?Set = \<open>cat_Set \<alpha>\<close>
	and ?Ym =
	\<open>
	\<lambda>b. Yoneda_map
	\<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<rparr>
	\<close>

	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<NN>: is_ntcf
	\<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close> \<NN>
	by (rule assms)

	have comm[unfolded cat_op_simps]:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<rparr> =
	f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
	if "g : a \<mapsto>\<^bsub>op_cat \<BB>\<^esub> c" and "f : b \<mapsto>\<^bsub>\<CC>\<^esub> d" and "q : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	for q g f a b c d
	proof-
	from that(1) have g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> a" unfolding cat_op_simps by simp
	from category_axioms assms g that(2) have ab:
	"[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
	from \<NN>.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have \<NN>ab:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> :
	Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	have \<NN>_abq: "(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	rule cat_Set_ArrVal_app_vrange[
	OF \<NN>ab, unfolded in_Hom_iff, OF that(3)
	]
	)
	have "[g, f]\<^sub>\<circ> : [a, b]\<^sub>\<circ> \<mapsto>\<^bsub>op_cat \<BB> \<times>\<^sub>C \<CC>\<^esub> [c, d]\<^sub>\<circ>"
	by
	(
	rule
	cat_prod_2_is_arrI[
	OF \<FF>.HomDom.category_op category_axioms that(1,2)
	]
	)
	then have
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
	then have
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>?Set\<^esub> ?H\<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> =
	(?H\<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>?Set\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr>"
	by auto

	from
	this that(2,3) assms
	category_axioms \<FF>.HomDom.category_axioms \<FF>.HomDom.category_op category_op
	g \<NN>ab \<NN>_abq
	show
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<rparr> =
	f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
	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 \<alpha> \<FF> \<GG> \<NN>)"
	unfolding af_Yoneda_arrow_def by simp
	show "vcard (af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>) = 5\<^sub>\<nat>"
	unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)

	have \<NN>b: "\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	by
	(
	rule
	bnt_proj_snd_is_ntcf
	[
	OF \<FF>.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 \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	proof-
	let ?\<GG>b = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<FF>b = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<CC>\<GG>b = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close>
	from that have \<CC>\<GG>b: "?\<CC>\<GG>b : ?\<GG>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b" by (auto simp: cat_cs_intros)
	from assms that have "[b, ?\<GG>b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_b\<GG>b:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>b ?\<GG>b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>b ?\<GG>b"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from \<CC>\<GG>b have \<NN>_b\<GG>b_\<CC>\<GG>b:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> : ?\<FF>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b"
	by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_b\<GG>b, unfolded in_Hom_iff])
	with category_axioms assms that \<NN>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 \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f
	proof-

	from that have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto

	let ?\<BB>a = \<open>\<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<close>
	and ?\<BB>b = \<open>\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<GG>a = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
	and ?\<GG>b = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<FF>a = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
	and ?\<FF>b = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	and ?\<CC>\<GG>a = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<close>
	and ?\<CC>\<GG>b = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close>

	from that have \<CC>\<GG>a: "?\<CC>\<GG>a : ?\<GG>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>a" by (auto intro: cat_cs_intros)
	from that have \<CC>\<GG>b: "?\<CC>\<GG>b : ?\<GG>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b" by (auto intro: cat_cs_intros)
	from that have \<BB>a: "?\<BB>a : a \<mapsto>\<^bsub>\<BB>\<^esub> a" by (auto intro: cat_cs_intros)

	from assms that have "[b, ?\<GG>b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_b\<GG>b:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>b ?\<GG>b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>b ?\<GG>b"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from \<CC>\<GG>b have \<NN>_b\<GG>b_\<CC>\<GG>b:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> : ?\<FF>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b"
	by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_b\<GG>b, unfolded in_Hom_iff])

	from assms that have "[a, ?\<GG>a]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_a\<GG>a:
	"\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>a ?\<GG>a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a ?\<GG>a"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from \<CC>\<GG>a have \<NN>_a\<GG>a_\<CC>\<GG>a:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>a\<rparr> : ?\<FF>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>a"
	by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_a\<GG>a, unfolded in_Hom_iff])

	from
	comm[OF \<BB>a \<GG>.cf_ArrMap_is_arr[OF that] \<CC>\<GG>a]
	category_axioms assms that \<NN>_a\<GG>a_\<CC>\<GG>a
	have \<NN>_a_\<GG>b[symmetric, cat_cs_simps]:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>a\<rparr>"
	by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	from comm[OF that \<CC>\<GG>b \<CC>\<GG>b] category_axioms assms that \<NN>_b\<GG>b_\<CC>\<GG>b
	have \<NN>_a_\<GG>b'[cat_cs_simps]:
	"(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> =
	(\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	from category_axioms assms that \<NN>b[OF a] \<NN>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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "\<beta> = \<alpha>"
	and "\<FF>' = \<FF>"
	and "\<GG>' = \<GG>"
	shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<CC>"
	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\<open>Yoneda Lemma for arbitrary functors\<close>


	text\<open>
	The following lemmas correspond to variants of the elements of Lemma 3
	in subsection 1.15 in \cite{bodo_categories_1970}.
	\<close>

	lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>-,-)"
	proof-

	let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
	and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
	and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>

	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))

	interpret \<NN>: is_ntcf \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>?H\<GG>\<close> \<open>?H\<FF>\<close> \<NN>
	by (rule assms(3))
	interpret aY\<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<open>?aYa \<NN>\<close>
	by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
	interpret HY\<NN>: is_ntcf
	\<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>?H\<GG>\<close> \<open>?H\<FF>\<close> \<open>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)\<close>
	by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aY\<NN>.is_ntcf_axioms])

	show [cat_cs_simps]: "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)"
	proof
	(
	rule sym,
	rule ntcf_eqI[OF HY\<NN>.is_ntcf_axioms assms(3)],
	rule vsv_eqI;
	(intro HY\<NN>.NTMap.vsv_axioms \<NN>.NTMap.vsv_axioms)?;
	(unfold \<NN>.ntcf_NTMap_vdomain HY\<NN>.ntcf_NTMap_vdomain)?
	)
	fix bc assume prems': "bc \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
	then obtain b c
	where bc_def: "bc = [b, c]\<^sub>\<circ>"
	and op_b: "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (auto intro: cat_prod_2_ObjE cat_cs_intros)
	from op_b have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp

	then have \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)
	have Ym_\<NN>:
	"Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
	\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	\<rparr> = ?aYa \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp

	from
	bnt_proj_snd_is_ntcf
	[
	OF \<FF>.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 \<NN>b: "\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by simp
	from c show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)\<lparr>NTMap\<rparr>\<lparr>bc\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>bc\<rparr>"
	unfolding
	bc_def
	cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aY\<NN>.is_ntcf_axioms b c]
	cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
	OF \<GG>b \<FF>b \<NN>b, unfolded Ym_\<NN>, symmetric
	]
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	qed simp_all

	qed

	lemma (in category) cat_af_Yoneda_Lemma:
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "v11 (af_Yoneda_map \<alpha> \<FF> \<GG>)"
	and "\<R>\<^sub>\<circ> (af_Yoneda_map \<alpha> \<FF> \<GG>) =
	these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
	and "(af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ> =
	(
	\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs
	\<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-).
	af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>
	)"
	proof-

	let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
	and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
	and ?aYm = \<open>af_Yoneda_map \<alpha> \<FF> \<GG>\<close>
	and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>

	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> 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 \<alpha> \<FF> \<GG>)" by (rule af_Yoneda_map_vsv[OF assms])

	fix \<phi> \<psi> assume prems:
	"\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	"\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	"?aYm\<lparr>\<phi>\<rparr> = ?aYm\<lparr>\<psi>\<rparr>"

	interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule prems(1))
	interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule prems(2))

	from prems(3) have H\<phi>_H\<psi>: "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<psi>-,-)"
	unfolding
	af_Yoneda_map_app[OF assms prems(1)]
	af_Yoneda_map_app[OF assms prems(2)]
	by simp

	show "\<phi> = \<psi>"
	proof
	(
	rule ntcf_eqI[OF prems(1,2)],
	rule vsv_eqI,
	unfold \<phi>.ntcf_NTMap_vdomain \<psi>.ntcf_NTMap_vdomain
	)
	fix b assume prems': "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	from prems' have \<phi>b: "\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<psi>b: "\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros cat_prod_cs_intros)
	have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)"
	proof
	(
	rule
	ntcf_eqI
	[
	OF
	cat_ntcf_Hom_snd_is_ntcf[OF \<phi>b]
	cat_ntcf_Hom_snd_is_ntcf[OF \<psi>b]
	]
	)
	show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold
	ntcf_Hom_snd_NTMap_vdomain[OF \<phi>b]
	ntcf_Hom_snd_NTMap_vdomain[OF \<psi>b]
	)
	fix c assume prems'': "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
	show
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	unfolding
	H[OF prems(1) prems' prems'', symmetric]
	H[OF prems(2) prems' prems'', symmetric]
	H\<phi>_H\<psi>
	by simp
	qed
	(
	simp_all add:
	ntcf_Hom_snd_NTMap_vsv[OF \<psi>b] ntcf_Hom_snd_NTMap_vsv[OF \<phi>b]
	)
	qed simp_all
	with \<phi>b \<psi>b show "\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by (auto intro: cat_ntcf_Hom_snd_inj)
	qed auto

	qed

	interpret aYm: v11 ?aYm by (rule v11_aY)

	have [cat_cs_simps]: "?aYm\<lparr>?aYa \<NN>\<rparr> = \<NN>"
	if "\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" for \<NN>
	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:
	"\<R>\<^sub>\<circ> ?aYm = these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>"
	proof(intro vsubset_antisym)

	show "\<R>\<^sub>\<circ> ?aYm \<subseteq>\<^sub>\<circ> these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
	)
	fix \<phi> assume "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	with category_axioms assms show
	"?aYm\<lparr>\<phi>\<rparr> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	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 \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> ?aYm"
	proof(rule vsubsetI, unfold these_ntcfs_iff)
	fix \<NN> assume prems:
	"\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	interpret aY\<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<open>?aYa \<NN>\<close>
	by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
	from prems have \<NN>_def: "\<NN> = ?aYm\<lparr>?aYa \<NN>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms aY\<NN>.is_ntcf_axioms have "?aYa \<NN> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ?aYm"
	by (cs_concl cs_shallow cs_simp: these_ntcfs_iff cat_cs_simps)
	then show "\<NN> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ?aYm" by (subst \<NN>_def, intro aYm.vsv_vimageI2) auto
	qed

	qed

	show "?aYm\<inverse>\<^sub>\<circ> =
	(\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>. ?aYa \<NN>)"
	proof
	(
	rule vsv_eqI,
	unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
	)
	from aYm.v11_axioms show "vsv ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>)" by auto
	fix \<NN> assume prems: "\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	then have \<NN>: "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>"
	by simp
	show "?aYm\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> =
	(\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>. ?aYa \<NN>)\<lparr>\<NN>\<rparr>"
	proof
	(
	intro aYm.v11_vconverse_app,
	unfold beta[OF \<NN>] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
	)
	from prems show \<NN>_def: "?aYm\<lparr>?aYa \<NN>\<rparr> = \<NN>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "?aYa \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
	qed
	qed simp_all

	qed


	subsubsection\<open>Inverse of the Yoneda map for arbitrary functors\<close>

	lemma (in category) inv_af_Yoneda_map_v11:
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "v11 ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>)"
	using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

	lemma (in category) inv_af_Yoneda_map_vdomain:
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<D>\<^sub>\<circ> ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>) =
	these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
	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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "(af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> = af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>"
	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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>) = these_ntcfs \<alpha> \<BB> \<CC> \<FF> \<GG>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	from assms show ?thesis
	unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
	qed


	subsubsection\<open>Yoneda map for arbitrary functors and natural isomorphisms\<close>


	text\<open>
	The following lemmas correspond to variants of the elements of
	Lemma 3 in subsection 1.15 in \cite{bodo_categories_1970}.
	\<close>

	lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
	assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	interpret \<phi>: is_iso_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
	show ?thesis
	proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
	fix b assume "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	then show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	auto intro!:
	- cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
	+ 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 "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<beta> = \<alpha>"
	and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
	and "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
	and "\<BB>' = op_cat \<BB> \<times>\<^sub>C \<CC>"
	and "\<CC>' = cat_Set \<alpha>"
	shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<CC>'"
	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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	let ?aYa = \<open>af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>

	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<NN>: is_iso_ntcf
	\<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close> \<NN>
	by (rule assms(3))

	from assms(1,2) \<NN>.is_ntcf_axioms have \<NN>_def: "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa-,-)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric]
	)

	from category_axioms assms have aYa: "?aYa : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have Hom_aYa: "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa-,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (auto intro: assms(3) simp add: \<NN>_def[symmetric])
	have Hb:
	"Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?aYa\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
	\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 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 \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	then have \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)
	from assms(1,2) aYa prems have aYa_b:
	"?aYa\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
	show "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	- rule cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf[
	+ 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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
	op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "\<beta> = \<alpha>"
	and "\<FF>' = \<FF>"
	and "\<GG>' = \<GG>"
	shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
	shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	proof-
	let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
	and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
	and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	from assms(3) obtain \<NN> \<AA> \<DD> where \<NN>: "\<NN> : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o ?H\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by auto
	interpret \<NN>: is_iso_ntcf \<alpha> \<AA> \<DD> ?H\<FF> ?H\<GG> \<NN> by (rule \<NN>)
	from category_axioms assms have "?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	then have \<AA>_def: "\<AA> = op_cat \<BB> \<times>\<^sub>C \<CC>" and \<DD>_def: "\<DD> = cat_Set \<alpha>"
	by (force simp: cat_cs_simps)+
	note \<NN> = \<NN>[unfolded \<AA>_def \<DD>_def]
	from \<NN> have "\<NN> : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F ?H\<GG> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros
	)
	from category_axioms assms \<NN> have
	"af_Yoneda_arrow \<alpha> \<GG> \<FF> \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	then have "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>" 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 "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	shows "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
	proof-
	let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
	and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
	and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
	interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	from assms obtain \<BB>' \<CC>' \<phi> where \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	by auto
	interpret \<phi>: is_iso_ntcf \<alpha> \<BB>' \<CC>' \<FF> \<GG> \<phi> by (rule \<phi>)
	from assms \<phi>.NTDom.is_functor_axioms
	have \<BB>'_def: "\<BB>' = \<BB>" and \<CC>'_def: "\<CC>' = \<CC>"
	by fast+
	note \<phi> = \<phi>[unfolded \<BB>'_def \<CC>'_def]
	show ?thesis
	by (rule iso_functor_sym)
	(
	intro iso_functorI[
	OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF \<phi>]
	]
	)
	qed

	lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
	assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
	and "\<alpha>' = \<alpha>"
	and "\<CC>' = \<CC>"
	shows "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>'\<^esub>\<CC>'(\<GG>-,-)"
	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\<open>The Yoneda Functor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>


	definition Yoneda_functor :: "V \<Rightarrow> V \<Rightarrow> V"
	where "Yoneda_functor \<alpha> \<DD> =
	[
	(\<lambda>r\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(r,-))),
	(\<lambda>f\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Arr\<rparr>. ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(f,-))),
	op_cat \<DD>,
	cat_FUNCT \<alpha> \<DD> (cat_Set \<alpha>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma Yoneda_functor_components:
	shows "Yoneda_functor \<alpha> \<DD>\<lparr>ObjMap\<rparr> =
	(\<lambda>r\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(r,-)))"
	and "Yoneda_functor \<alpha> \<DD>\<lparr>ArrMap\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Arr\<rparr>. ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(f,-)))"
	and "Yoneda_functor \<alpha> \<DD>\<lparr>HomDom\<rparr> = op_cat \<DD>"
	and "Yoneda_functor \<alpha> \<DD>\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> \<DD> (cat_Set \<alpha>)"
	unfolding Yoneda_functor_def dghm_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	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:
	"\<R>\<^sub>\<circ> (Yoneda_functor \<alpha> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
	proof
	(
	unfold Yoneda_functor_components,
	rule vrange_VLambda_vsubset,
	unfold cat_op_simps
	)
	fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with category_axioms show
	"cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
	unfolding cat_op_simps cat_FUNCT_components
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed


	subsubsection\<open>Arrow map\<close>

	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:
	"\<R>\<^sub>\<circ> (Yoneda_functor \<alpha> \<CC>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Arr\<rparr>"
	proof
	(
	unfold Yoneda_functor_components,
	rule vrange_VLambda_vsubset,
	unfold cat_op_simps
	)
	fix f assume "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	then obtain a b where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<Z>\<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<Z>_\<alpha>_\<alpha>\<omega> \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<beta>_def)
	from tiny_category_cat_FUNCT category_axioms \<Z>\<beta> \<alpha>\<beta> f show
	"ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Arr\<rparr>"
	unfolding cat_op_simps
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	qed


	subsubsection\<open>The Yoneda Functor is a fully faithful functor\<close>

	lemma (in category) cat_Yoneda_functor_is_functor:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "Yoneda_functor \<alpha> \<CC> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)"
	proof
	(
	intro
	is_ff_functorI
	is_ft_functorI'
	is_fl_functorI'
	vsubset_antisym
	vsubsetI,
	unfold cat_op_simps in_Hom_iff,
	tactic\<open>distinct_subgoals_tac\<close>
	)

	interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)

	let ?Yf = \<open>Yoneda_functor \<alpha> \<CC>\<close> and ?FUNCT = \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>

	show Yf: "?Yf : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> ?FUNCT"
	proof(intro is_functorI')
	show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
	from assms have "category \<beta> \<CC>" by (intro cat_category_if_ge_Limit)
	then show "category \<beta> (op_cat \<CC>)" by (intro category.category_op)
	from assms show "category \<beta> ?FUNCT"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT
	)
	show "vcard ?Yf = 4\<^sub>\<nat>"
	unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (?Yf\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ?FUNCT\<lparr>Obj\<rparr>"
	by (rule Yoneda_functor_ObjMap_vrange)
	show
	"?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<CC>\<^esub> 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\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f\<rparr> =
	?Yf\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> ?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>op_cat \<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<CC>\<^esub> 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\<lparr>ArrMap\<rparr>\<lparr>op_cat \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = ?FUNCT\<lparr>CId\<rparr>\<lparr>?Yf\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>" 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 \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega>)

	interpret Yf: is_functor \<beta> \<open>op_cat \<CC>\<close> \<open>?FUNCT\<close> \<open>?Yf\<close> by (rule Yf)

	show "v11 (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a b
	proof-
	from that have dom_Y_ba: "\<D>\<^sub>\<circ> (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a) = Hom \<CC> b a"
	by
	(
	fastforce simp:
	cat_op_simps
	in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
	)

	show "v11 (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)"
	proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
	fix g f assume prems:
	"g : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	"(?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)\<lparr>g\<rparr> = (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)\<lparr>f\<rparr>"
	from
	prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of \<alpha> \<CC>]
	have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	show "\<NN> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "\<NN> \<in>\<^sub>\<circ> ?Yf\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a" for \<NN>
	proof-
	from that obtain f where "?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<NN>" and f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by (force elim!: Yf.ArrMap.vsv_vimageE)
	then have \<NN>_def: "\<NN> = ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(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 \<NN>_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
	)
	qed
	show "\<NN> \<in>\<^sub>\<circ> ?Yf\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a"
	if "\<NN> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" for \<NN>
	proof-
	note \<NN> = cat_FUNCT_is_arrD[OF that]
	from \<NN>(1) category_axioms prems have ntcf_\<NN>:
	"ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<NN> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (subst (asm) \<NN>(3), use nothing in \<open>subst (asm) \<NN>(4)\<close>)
	(
	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_\<NN>] obtain f
	where f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and \<NN>_def: "ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
	by auto
	from \<NN>(2) f show "\<NN> \<in>\<^sub>\<circ> Yoneda_functor \<alpha> \<CC>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a"
	unfolding \<NN>_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\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/ROOT b/thys/CZH_Foundations/ROOT
	--- a/thys/CZH_Foundations/ROOT
	+++ b/thys/CZH_Foundations/ROOT
	@@ -1,31 +1,30 @@
	chapter AFP

	session CZH_Foundations (AFP) = ZFC_in_HOL +
	options [timeout = 2400]
	sessions
	"HOL-Library"
	- "HOL-ex"
	Intro_Dest_Elim
	Conditional_Simplification
	"HOL-Eisbach"
	directories
	czh_introduction
	czh_sets
	"czh_sets/ex"
	czh_digraphs
	czh_semicategories
	theories [document = false]
	CZH_Sets_MIF
	CZH_Utilities
	theories
	CZH_Introduction
	CZH_Sets_Conclusions
	CZH_DG_Conclusions
	CZH_SMC_Conclusions
	document_files
	"iman.sty"
	"extra.sty"
	"isar.sty"
	"style.sty"
	"root.tex"
	- "root.bib"
	+ "root.bib"
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
	@@ -1,1882 +1,1971 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Homomorphism of digraphs\<close>
	theory CZH_DG_DGHM
	imports CZH_DG_Digraph
	begin



	subsection\<open>Background\<close>

	named_theorems dghm_cs_simps
	named_theorems dghm_cs_intros

	named_theorems dg_cn_cs_simps
	named_theorems dg_cn_cs_intros

	named_theorems dghm_field_simps

	definition ObjMap :: V where [dghm_field_simps]: "ObjMap = 0"
	definition ArrMap :: V where [dghm_field_simps]: "ArrMap = 1\<^sub>\<nat>"
	definition HomDom :: V where [dghm_field_simps]: "HomDom = 2\<^sub>\<nat>"
	definition HomCod :: V where [dghm_field_simps]: "HomCod = 3\<^sub>\<nat>"



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	A homomorphism of digraphs, as presented in this work, can be seen as a
	generalization of the concept of a functor between categories, as presented in
	Chapter I-3 in \cite{mac_lane_categories_2010}, to digraphs.
	The generalization is performed by removing the axioms (1) from the definition.
	It is expected that the resulting definition is consistent with the conventional
	notion of a homomorphism of digraphs in graph theory, but further details
	are considered to be outside of the scope of this work.

	The definition of a digraph homomorphism is parameterized by a limit ordinal
	\<open>\<alpha>\<close> such that \<open>\<omega> < \<alpha>\<close>. Such digraph homomorphisms are referred to either as
	\<open>\<alpha>\<close>-digraph homomorphisms or homomorphisms of \<open>\<alpha>\<close>-digraphs.

	Following \cite{mac_lane_categories_2010}, all digraph homomorphisms are
	covariant (see Chapter II-2). However, a special notation is adapted for the
	digraph homomorphisms from an opposite digraph. Normally, such
	digraph homomorphisms will be referred to as the contravariant digraph
	homomorphisms, but this convention will not be enforced.
	\<close>

	locale is_dghm =
	\<Z> \<alpha> + vfsequence \<FF> + HomDom: digraph \<alpha> \<AA> + HomCod: digraph \<alpha> \<BB>
	for \<alpha> \<AA> \<BB> \<FF> +
	assumes dghm_length[dg_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>"
	and dghm_HomDom[dg_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and dghm_HomCod[dg_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and dghm_ObjMap_vsv: "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and dghm_ArrMap_vsv: "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and dghm_ObjMap_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and dghm_ObjMap_vrange: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and dghm_ArrMap_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and dghm_ArrMap_is_arr:
	"f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"

	syntax "_is_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_dghm \<alpha> \<AA> \<BB> \<FF>"

	abbreviation (input) is_cn_dghm :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_cn_dghm \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"

	syntax "_is_cn_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_dghm \<alpha> \<AA> \<BB> \<FF>"

	abbreviation all_dghms :: "V \<Rightarrow> V"
	where "all_dghms \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation dghms :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "dghms \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"

	sublocale is_dghm \<subseteq> ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (rule dghm_ObjMap_vsv) (simp add: dg_cs_simps)

	sublocale is_dghm \<subseteq> ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	by (rule dghm_ArrMap_vsv) (simp add: dg_cs_simps)

	lemmas [dg_cs_simps] =
	is_dghm.dghm_HomDom
	is_dghm.dghm_HomCod
	is_dghm.dghm_ObjMap_vdomain
	is_dghm.dghm_ArrMap_vdomain

	lemma (in is_dghm) dghm_ArrMap_is_arr''[dg_cs_intros]:
	assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and "\<FF>f = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	shows "\<FF>f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	using assms(1) unfolding assms(2) by (rule dghm_ArrMap_is_arr)

	lemma (in is_dghm) dghm_ArrMap_is_arr'[dg_cs_intros]:
	assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>\<BB>\<^esub> B"
	using assms(1) unfolding assms(2,3) by (rule dghm_ArrMap_is_arr)

	lemmas [dg_cs_intros] = is_dghm.dghm_ArrMap_is_arr'


	text\<open>Rules.\<close>

	lemma (in is_dghm) is_dghm_axioms'[dg_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_dghm_axioms)

	mk_ide rf is_dghm_def[unfolded is_dghm_axioms_def]
	\|intro is_dghmI\|
	\|dest is_dghmD[dest]\|
	\|elim is_dghmE[elim]\|

	lemmas [dg_cs_intros] = is_dghmD(3,4)


	text\<open>Elementary properties.\<close>

	lemma dghm_eqI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	shows "\<GG> = \<FF>"
	proof-
	interpret L: is_dghm \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps)
	from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by (simp_all add: dg_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
	(auto simp: dghm_field_simps)
	qed (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps cs_intro: V_cs_intros)+
	qed

	lemma (in is_dghm) dghm_def: "\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
	(simp_all add: nat_omega_simps)
	qed (auto simp: vsv_axioms)

	lemma (in is_dghm) dghm_ObjMap_app_in_HomCod_Obj[dg_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	using assms dghm_ObjMap_vrange by (blast dest: ObjMap.vsv_vimageI2)

	lemmas [dg_cs_intros] = is_dghm.dghm_ObjMap_app_in_HomCod_Obj

	lemma (in is_dghm) dghm_ArrMap_vrange: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold dg_cs_simps)
	fix f assume "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	then obtain a b where "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" by auto
	then have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_shallow cs_intro: dg_cs_intros)
	then show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto
	qed auto

	lemma (in is_dghm) dghm_ArrMap_app_in_HomCod_Arr[dg_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	using assms dghm_ArrMap_vrange by (blast dest: ArrMap.vsv_vimageI2)

	lemmas [dg_cs_intros] = is_dghm.dghm_ArrMap_app_in_HomCod_Arr


	text\<open>Size.\<close>

	lemma (in is_dghm) dghm_ObjMap_vsubset_Vset: "\<FF>\<lparr>ObjMap\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	rule ObjMap.vbrelation_Limit_vsubset_VsetI,
	insert dghm_ObjMap_vrange HomCod.dg_Obj_vsubset_Vset
	)
	(auto intro!: HomDom.dg_Obj_vsubset_Vset)

	lemma (in is_dghm) dghm_ArrMap_vsubset_Vset: "\<FF>\<lparr>ArrMap\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	rule ArrMap.vbrelation_Limit_vsubset_VsetI,
	insert dghm_ArrMap_vrange HomCod.dg_Arr_vsubset_Vset
	)
	(auto intro!: HomDom.dg_Arr_vsubset_Vset)

	lemma (in is_dghm) dghm_ObjMap_in_Vset:
	assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (meson assms dghm_ObjMap_vsubset_Vset Vset_in_mono vsubset_in_VsetI)

	lemma (in is_dghm) dghm_ArrMap_in_Vset:
	assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (meson assms dghm_ArrMap_vsubset_Vset Vset_in_mono vsubset_in_VsetI)

	lemma (in is_dghm) dghm_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [dg_cs_intros] =
	dghm_ObjMap_in_Vset dghm_ArrMap_in_Vset HomDom.dg_in_Vset HomCod.dg_in_Vset
	from assms(2) show ?thesis
	by (subst dghm_def)
	(
	cs_concl cs_shallow
	cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros
	)
	qed

	lemma (in is_dghm) dghm_is_dghm_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<beta>\<^esub> \<BB>"
	proof(rule is_dghmI)
	from is_dghm_axioms assms show "digraph \<beta> \<AA>"
	by (cs_concl cs_intro: digraph.dg_digraph_if_ge_Limit dg_cs_intros)
	from is_dghm_axioms assms show "digraph \<beta> \<BB>"
	by (cs_concl cs_intro: digraph.dg_digraph_if_ge_Limit dg_cs_intros)
	qed
	(
	cs_concl
	cs_simp: dg_cs_simps
	cs_intro: assms(1) dg_cs_intros V_cs_intros dghm_ObjMap_vrange
	)+

	lemma small_all_dghms[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_dghm.dghm_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>] subsetI)
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in is_dghm) dghm_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], dg_cs_intros] =
	dghm_ObjMap_vsubset_Vset
	dghm_ArrMap_vsubset_Vset
	from HomDom.dg_digraph_in_Vset_4 have [dg_cs_intros]:
	"\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	from HomCod.dg_digraph_in_Vset_4 have [dg_cs_intros]:
	"\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	show ?thesis
	by (subst dghm_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps dg_cs_simps
	cs_intro: dg_cs_intros V_cs_intros
	)
	qed

	lemma (in \<Z>) all_dghms_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "all_dghms \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "all_dghms \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_dghms \<alpha>"
	then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
	interpret is_dghm \<alpha> \<AA> \<BB> \<FF> using \<FF> by simp
	show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule dghm_in_Vset_7)
	qed
	from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma small_dghms[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto


	-text\<open>Further elementary properties.\<close>
	+text\<open>Further properties.\<close>

	lemma (in is_dghm) dghm_is_arr_HomCod:
	assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	using assms by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+

	lemma (in is_dghm) dghm_vimage_dghm_ArrMap_vsubset_Hom:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b \<subseteq>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof(intro vsubsetI)
	fix g assume "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
	then obtain f where "f \<in>\<^sub>\<circ> Hom (\<FF>\<lparr>HomDom\<rparr>) a b" and "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (auto simp: dg_cs_simps)
	then show "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (simp add: dghm_ArrMap_is_arr dg_cs_simps)
	qed



	subsection\<open>Opposite digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_dghm :: "V \<Rightarrow> V"
	where "op_dghm \<FF> =
	[\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_dg (\<FF>\<lparr>HomDom\<rparr>), op_dg (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_dghm_components[dg_op_simps]:
	shows "op_dghm \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "op_dghm \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "op_dghm \<FF>\<lparr>HomDom\<rparr> = op_dg (\<FF>\<lparr>HomDom\<rparr>)"
	and "op_dghm \<FF>\<lparr>HomCod\<rparr> = op_dg (\<FF>\<lparr>HomCod\<rparr>)"
	unfolding op_dghm_def dghm_field_simps by (auto simp: nat_omega_simps)


	subsubsection\<open>Further properties\<close>

	lemma (in is_dghm) is_dghm_op: "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	proof(intro is_dghmI, unfold dg_op_simps)
	show "vfsequence (op_dghm \<FF>)" unfolding op_dghm_def by simp
	show "vcard (op_dghm \<FF>) = 4\<^sub>\<nat>"
	unfolding op_dghm_def by (auto simp: nat_omega_simps)
	qed
	(
	cs_concl cs_shallow
	cs_intro: dghm_ObjMap_vrange dg_cs_intros dg_op_intros V_cs_intros
	cs_simp: dg_cs_simps dg_op_simps
	)+

	lemma (in is_dghm) is_dghm_op'[dg_op_intros]:
	assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>" and "\<alpha>' = \<alpha>"
	shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_dghm_op)

	lemmas is_dghm_op[dg_op_intros] = is_dghm.is_dghm_op'

	lemma (in is_dghm) dghm_op_dghm_op_dghm[dg_op_simps]: "op_dghm (op_dghm \<FF>) = \<FF>"
	using is_dghm_axioms
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_op_simps
	cs_intro: dg_op_intros dghm_eqI[where \<FF>=\<FF>]
	)

	lemmas dghm_op_dghm_op_dghm[dg_op_simps] = is_dghm.dghm_op_dghm_op_dghm

	lemma eq_op_dghm_iff[dg_op_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "op_dghm \<GG> = op_dghm \<FF> \<longleftrightarrow> \<GG> = \<FF>"
	proof
	interpret L: is_dghm \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	assume prems: "op_dghm \<GG> = op_dghm \<FF>"
	show "\<GG> = \<FF>"
	proof(rule dghm_eqI[OF assms])
	from prems R.dghm_op_dghm_op_dghm L.dghm_op_dghm_op_dghm show
	"\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	by metis+
	from prems R.dghm_op_dghm_op_dghm L.dghm_op_dghm_op_dghm have
	"\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by auto
	then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (auto simp: dg_cs_simps)
	qed
	qed auto



	subsection\<open>Composition of covariant digraph homomorphisms\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	definition dghm_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<close> 55)
	where "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> =
	[\<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>, \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<GG>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dghm_comp_components:
	shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
	and [dg_shared_cs_simps, dg_cs_simps]: "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	and [dg_shared_cs_simps, dg_cs_simps]: "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
	unfolding dghm_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma dghm_comp_ObjMap_vsv[dg_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis by (cs_concl cs_simp: dghm_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_comp_ObjMap_vdomain[dg_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
	cs_intro: is_dghm.dghm_ObjMap_vrange
	)

	lemma dghm_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_comp_components
	cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros
	)

	lemma dghm_comp_ObjMap_app[dg_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	from assms(3) show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
	cs_intro: V_cs_intros dg_cs_intros
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma dghm_comp_ArrMap_vsv[dg_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by (cs_concl cs_simp: dghm_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_comp_ArrMap_vdomain[dg_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
	cs_intro: is_dghm.dghm_ArrMap_vrange
	)

	lemma dghm_comp_ArrMap_vrange[dg_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_comp_components
	cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros
	)

	lemma dghm_comp_ArrMap_app[dg_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	from assms(3) show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
	cs_intro: V_cs_intros dg_cs_intros
	)
	qed


	subsubsection\<open>Opposite of the composition of covariant digraph homomorphisms\<close>

	lemma op_dghm_dghm_comp[dg_op_simps]:
	"op_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = op_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_dghm \<FF>"
	unfolding dghm_comp_def op_dghm_def dghm_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Further properties\<close>

	lemma dghm_comp_is_dghm[dg_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(intro is_dghmI is_dghmI, unfold dg_cs_simps)
	show "vfsequence (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)" unfolding dghm_comp_def by simp
	show "vcard (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = 4\<^sub>\<nat>"
	unfolding dghm_comp_def by (simp add: nat_omega_simps)
	fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	with assms show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed
	(
	use assms in
	\<open>
	cs_concl cs_shallow
	cs_intro: dg_cs_intros dghm_comp_ObjMap_vrange
	cs_simp: dg_cs_simps
	\<close>
	)+
	qed

	lemma dghm_comp_assoc[dg_cs_simps]:
	assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = \<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)"
	proof(rule dghm_eqI [of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
	show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI)
	show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)" for a
	using that assms
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed (use assms in \<open>cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>)+
	show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI)
	show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)" for a
	using that assms
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed
	(
	use assms in
	\<open>cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>
	)+
	qed (use assms in \<open>cs_concl cs_shallow cs_intro: dg_cs_intros\<close>)+



	subsection\<open>Composition of contravariant digraph homomorphisms\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>

	definition dghm_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ>\<close> 55)
	where "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> =
	[
	\<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>,
	\<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>,
	op_dg (\<FF>\<lparr>HomDom\<rparr>),
	\<GG>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dghm_cn_comp_components:
	shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
	and [dg_cn_cs_simps]: "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_dg (\<FF>\<lparr>HomDom\<rparr>)"
	and [dg_cn_cs_simps]: "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
	unfolding dghm_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map: two contravariant digraph homomorphisms\<close>

	lemma dghm_cn_comp_ObjMap_vsv[dg_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_cn_comp_ObjMap_vdomain[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: is_dghm.dghm_ObjMap_vrange
	)

	lemma dghm_cn_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cn_comp_components
	cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros
	)

	lemma dghm_cn_comp_ObjMap_app[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: V_cs_intros dg_cs_intros
	)
	qed


	subsubsection\<open>Arrow map: two contravariant digraph homomorphisms\<close>

	lemma dghm_cn_comp_ArrMap_vsv[dg_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_cn_comp_ArrMap_vdomain[dg_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: is_dghm.dghm_ArrMap_vrange
	)

	lemma dghm_cn_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cn_comp_components
	cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros
	)

	lemma dghm_cn_comp_ArrMap_app[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: V_cs_intros dg_cs_intros
	)
	qed


	subsubsection\<open>Object map: contravariant and covariant digraph homomorphisms\<close>

	lemma dghm_cn_cov_comp_ObjMap_vsv[dg_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_cn_cov_comp_ObjMap_vdomain[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: is_dghm.dghm_ObjMap_vrange
	)

	lemma dghm_cn_cov_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cn_comp_components
	cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros
	)

	lemma dghm_cn_cov_comp_ObjMap_app[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	from assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps V_cs_simps
	cs_intro: V_cs_intros dg_op_intros dg_cs_intros
	)
	qed


	subsubsection\<open>Arrow map: contravariant and covariant digraph homomorphisms\<close>

	lemma dghm_cn_cov_comp_ArrMap_vsv[dg_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
	qed

	lemma dghm_cn_cov_comp_ArrMap_vdomain[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
	cs_intro: is_dghm.dghm_ArrMap_vrange
	)

	lemma dghm_cn_cov_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cn_comp_components
	cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros
	)

	lemma dghm_cn_cov_comp_ArrMap_app[dg_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: dghm_cn_comp_components dg_cs_simps V_cs_simps
	cs_intro: V_cs_intros dg_op_intros dg_cs_intros
	)
	qed


	subsubsection\<open>
	Opposite of the contravariant composition of the digraph homomorphisms
	\<close>

	lemma op_dghm_dghm_cn_comp[dg_op_simps]:
	"op_dghm (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = op_dghm \<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> op_dghm \<FF>"
	unfolding op_dghm_def dghm_cn_comp_def dghm_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>Further properties\<close>

	lemma dghm_cn_comp_is_dghm[dg_cn_cs_intros]:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
	assumes "digraph \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<AA>: digraph \<alpha> \<AA> by (rule assms(1))
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> using assms(2) by auto
	interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> using assms(3) by auto
	show ?thesis
	proof(intro is_dghmI, unfold dg_op_simps dg_cs_simps dg_cn_cs_simps)
	show "vfsequence (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)" unfolding dghm_cn_comp_def by auto
	show "vcard (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = 4\<^sub>\<nat>"
	unfolding dghm_cn_comp_def by (simp add: nat_omega_simps)
	fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	with assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl
	cs_simp: dg_cn_cs_simps
	cs_intro: dg_cs_intros dg_op_intros
	)
	qed
	(
	cs_concl
	cs_simp: dg_cs_simps dg_cn_cs_simps
	cs_intro: dghm_cn_comp_ObjMap_vrange dg_cs_intros dg_cn_cs_intros
	)+
	qed

	lemma dghm_cn_cov_comp_is_dghm[dg_cn_cs_intros]:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
	assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(intro is_dghmI, unfold dg_op_simps dg_cs_simps)
	show "vfsequence (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)" unfolding dghm_cn_comp_def by simp
	show "vcard (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = 4\<^sub>\<nat>"
	unfolding dghm_cn_comp_def by (auto simp: nat_omega_simps)
	fix f b a assume "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	with assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (cs_concl cs_simp: dg_cn_cs_simps dg_op_simps cs_intro: dg_cs_intros)
	qed
	(
	cs_concl cs_shallow
	cs_simp: dg_cs_simps dg_cn_cs_simps
	cs_intro:
	dghm_cn_cov_comp_ObjMap_vrange
	dg_cs_intros dg_cn_cs_intros dg_op_intros
	)+
	qed

	lemma dghm_cov_cn_comp_is_dghm:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by (rule dghm_comp_is_dghm)



	subsection\<open>Identity digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	definition dghm_id :: "V \<Rightarrow> V"
	where "dghm_id \<CC> = [vid_on (\<CC>\<lparr>Obj\<rparr>), vid_on (\<CC>\<lparr>Arr\<rparr>), \<CC>, \<CC>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dghm_id_components:
	shows "dghm_id \<CC>\<lparr>ObjMap\<rparr> = vid_on (\<CC>\<lparr>Obj\<rparr>)"
	and "dghm_id \<CC>\<lparr>ArrMap\<rparr> = vid_on (\<CC>\<lparr>Arr\<rparr>)"
	and [dg_shared_cs_simps, dg_cs_simps]: "dghm_id \<CC>\<lparr>HomDom\<rparr> = \<CC>"
	and [dg_shared_cs_simps, dg_cs_simps]: "dghm_id \<CC>\<lparr>HomCod\<rparr> = \<CC>"
	unfolding dghm_id_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda dghm_id_components(1)[folded VLambda_vid_on]
	\|vsv dghm_id_ObjMap_vsv[dg_shared_cs_intros, dg_cs_intros]\|
	\|vdomain dghm_id_ObjMap_vdomain[dg_shared_cs_simps, dg_cs_simps]\|
	\|app dghm_id_ObjMap_app[dg_shared_cs_simps, dg_cs_simps]\|

	lemma dghm_id_ObjMap_vrange[dg_shared_cs_simps, dg_cs_simps]:
	"\<R>\<^sub>\<circ> (dghm_id \<CC>\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	unfolding dghm_id_components by simp


	subsubsection\<open>Arrow map\<close>

	mk_VLambda dghm_id_components(2)[folded VLambda_vid_on]
	\|vsv dghm_id_ArrMap_vsv[dg_shared_cs_intros, dg_cs_intros]\|
	\|vdomain dghm_id_ArrMap_vdomain[dg_shared_cs_simps, dg_cs_simps]\|
	\|app dghm_id_ArrMap_app[dg_shared_cs_simps, dg_cs_simps]\|

	lemma dghm_id_ArrMap_vrange[dg_shared_cs_simps, dg_cs_simps]:
	"\<R>\<^sub>\<circ> (dghm_id \<CC>\<lparr>ArrMap\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	unfolding dghm_id_components by simp


	subsubsection\<open>Opposite identity digraph homomorphism\<close>

	lemma op_dghm_dghm_id[dg_op_simps]: "op_dghm (dghm_id \<CC>) = dghm_id (op_dg \<CC>)"
	unfolding dghm_id_def op_dg_def op_dghm_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>An identity digraph homomorphism is a digraph homomorphism\<close>

	lemma (in digraph) dg_dghm_id_is_dghm: "dghm_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_dghmI, unfold dg_cs_simps)
	show "vfsequence (dghm_id \<CC>)" unfolding dghm_id_def by simp
	show "vcard (dghm_id \<CC>) = 4\<^sub>\<nat>"
	unfolding dghm_id_def by (simp add: nat_omega_simps)
	qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+

	lemma (in digraph) dg_dghm_id_is_dghm':
	assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
	shows "dghm_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule dg_dghm_id_is_dghm)

	lemmas [dg_cs_intros] = digraph.dg_dghm_id_is_dghm'


	subsubsection\<open>Further properties\<close>

	lemma (in is_dghm) dghm_dghm_comp_dghm_id_left: "dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = \<FF>"
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	proof(rule dghm_eqI [of \<alpha> \<AA> \<BB> _ \<AA> \<BB>])
	show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI)
	show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)" for a
	using that
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
	show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI)
	show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)" for a
	using that
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
	qed (cs_concl cs_shallow cs_simp: cs_intro: dg_cs_intros)+

	lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_id_left

	lemma (in is_dghm) dghm_dghm_comp_dghm_id_right: "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA> = \<FF>"
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	proof(rule dghm_eqI [of \<alpha> \<AA> \<BB> _ \<AA> \<BB>])
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI)
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr>)" for a
	using that
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI)
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr>)" for a
	using that
	by
	(cs_prems cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	(cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
	qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
	qed (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+

	lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_id_right



	subsection\<open>Constant digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	definition dghm_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "dghm_const \<CC> \<DD> a f =
	[vconst_on (\<CC>\<lparr>Obj\<rparr>) a, vconst_on (\<CC>\<lparr>Arr\<rparr>) f, \<CC>, \<DD>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dghm_const_components:
	shows "dghm_const \<CC> \<DD> a f\<lparr>ObjMap\<rparr> = vconst_on (\<CC>\<lparr>Obj\<rparr>) a"
	and "dghm_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr> = vconst_on (\<CC>\<lparr>Arr\<rparr>) f"
	and [dg_shared_cs_simps, dg_cs_simps]: "dghm_const \<CC> \<DD> a f\<lparr>HomDom\<rparr> = \<CC>"
	and [dg_shared_cs_simps, dg_cs_simps]: "dghm_const \<CC> \<DD> a f\<lparr>HomCod\<rparr> = \<DD>"
	unfolding dghm_const_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda dghm_const_components(1)[folded VLambda_vconst_on]
	\|vsv dghm_const_ObjMap_vsv[dg_shared_cs_intros, dg_cs_intros]\|
	\|vdomain dghm_const_ObjMap_vdomain[dg_shared_cs_simps, dg_cs_simps]\|
	\|app dghm_const_ObjMap_app[dg_shared_cs_simps, dg_cs_simps]\|


	subsubsection\<open>Arrow map\<close>

	mk_VLambda dghm_const_components(2)[folded VLambda_vconst_on]
	\|vsv dghm_const_ArrMap_vsv[dg_shared_cs_intros, dg_cs_intros]\|
	\|vdomain dghm_const_ArrMap_vdomain[dg_shared_cs_simps, dg_cs_simps]\|
	\|app dghm_const_ArrMap_app[dg_shared_cs_simps, dg_cs_simps]\|


	subsubsection\<open>Opposite constant digraph homomorphism\<close>

	lemma op_dghm_dghm_const[dg_op_simps]:
	"op_dghm (dghm_const \<CC> \<DD> a f) = dghm_const (op_dg \<CC>) (op_dg \<DD>) a f"
	unfolding dghm_const_def op_dg_def op_dghm_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>A constant digraph homomorphism is a digraph homomorphism\<close>

	lemma dghm_const_is_dghm:
	assumes "digraph \<alpha> \<CC>" and "digraph \<alpha> \<DD>" and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
	shows "dghm_const \<CC> \<DD> a f : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	interpret \<DD>: digraph \<alpha> \<DD> by (rule assms(2))
	show ?thesis
	proof(intro is_dghmI)
	show "vfsequence (dghm_const \<CC> \<DD> a f)"
	unfolding dghm_const_def by simp
	show "vcard (dghm_const \<CC> \<DD> a f) = 4\<^sub>\<nat>"
	unfolding dghm_const_def by (simp add: nat_omega_simps)
	qed
	(
	use assms in
	\<open>
	cs_concl
	cs_simp: dghm_const_components(1) dg_cs_simps
	cs_intro: V_cs_intros dg_cs_intros
	\<close>
	)+
	qed

	lemma dghm_const_is_dghm'[dg_cs_intros]:
	assumes "digraph \<alpha> \<CC>"
	and "digraph \<alpha> \<DD>"
	and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	shows "dghm_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1-3) unfolding assms(4,5) by (rule dghm_const_is_dghm)


	subsubsection\<open>Further properties\<close>

	lemma (in is_dghm) dghm_dghm_comp_dghm_const[dg_cs_simps]:
	assumes "digraph \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
	shows "dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_const \<AA> \<CC> a f"
	proof(rule dghm_eqI)
	interpret \<CC>: digraph \<alpha> \<CC> by (rule assms(1))
	from assms(2) show "dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: dg_cs_intros)
	with assms(2) have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	by (cs_concl cs_simp: dg_cs_simps)+
	from assms(2) show "dghm_const \<AA> \<CC> a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: dg_cs_intros)
	- with assms(2) have ObjMap_dom_rhs:
	- "\<D>\<^sub>\<circ> (dghm_const \<AA> \<CC> a f\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	+ with assms(2) have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (dghm_const \<AA> \<CC> a f\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (dghm_const \<AA> \<CC> a f\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps)+
	show "(dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = dghm_const \<AA> \<CC> a f\<lparr>ObjMap\<rparr>"
	by (rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	(
	use assms(2) in
	\<open>cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>
	)+
	show "(dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = dghm_const \<AA> \<CC> a f\<lparr>ArrMap\<rparr>"
	by (rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	(
	use assms(2) in
	\<open>cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>
	)+
	qed simp_all

	lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_const



	subsection\<open>Faithful digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_ft_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes ft_dghm_v11_on_Hom:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"

	syntax "_is_ft_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_dghm \<alpha> \<AA> \<BB> \<FF>"


	text\<open>Rules.\<close>

	lemma (in is_ft_dghm) is_ft_dghm_axioms'[dghm_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_ft_dghm_axioms)

	mk_ide rf is_ft_dghm_def[unfolded is_ft_dghm_axioms_def]
	\|intro is_ft_dghmI\|
	\|dest is_ft_dghmD[dest]\|
	\|elim is_ft_dghmE[elim]\|

	lemmas [dghm_cs_intros] = is_ft_dghmD(1)

	+lemma is_ft_dghmI'':
	+ assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<And>a b g f.
	+ \<lbrakk> g : a \<mapsto>\<^bsub>\<AA>\<^esub> b; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b; \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<rbrakk> \<Longrightarrow> g = f"
	+ shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	+proof(intro is_ft_dghmI assms)
	+ interpret \<FF>: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
	+ fix a b assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ have dom_def: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b) = Hom \<AA> a b"
	+ by (intro vdomain_vlrestriction_vsubset vsubsetI) (auto simp: dg_cs_simps)
	+ show "v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	+ proof(intro vsv.vsv_valeq_v11I, unfold dom_def dg_cs_simps)
	+ from prems show "vsv (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)" by auto
	+ fix g f assume prems:
	+ "g : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	+ "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	+ "(\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)\<lparr>g\<rparr> = (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)\<lparr>f\<rparr>"
	+ from prems(3,1,2) have \<FF>g_\<FF>f: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: V_cs_simps dg_cs_simps
	+ cs_intro: V_cs_intros dg_cs_intros
	+ )
	+ show "g = f" by (rule assms(2)[OF prems(1,2) \<FF>g_\<FF>f])
	+ qed
	+qed
	+

	subsubsection\<open>Opposite faithful digraph homomorphism\<close>

	lemma (in is_ft_dghm) ft_dghm_op_dghm_is_ft_dghm:
	"op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	by
	(
	rule is_ft_dghmI,
	unfold dg_op_simps,
	cs_concl cs_shallow cs_intro: dg_cs_intros dg_op_intros
	)
	(auto simp: ft_dghm_v11_on_Hom)

	lemma (in is_ft_dghm) ft_dghm_op_dghm_is_ft_dghm'[dg_op_intros]:
	assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
	shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ft_dghm_op_dghm_is_ft_dghm)

	lemmas ft_dghm_op_dghm_is_ft_dghm[dg_op_intros] =
	is_ft_dghm.ft_dghm_op_dghm_is_ft_dghm'


	subsubsection\<open>
	The composition of faithful digraph homomorphisms is a faithful
	digraph homomorphism.
	\<close>

	lemma dghm_comp_is_ft_dghm[dghm_cs_intros]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_ft_dghm \<alpha> \<BB> \<CC> \<GG> using assms(1) by auto
	interpret R: is_ft_dghm \<alpha> \<AA> \<BB> \<FF> using assms(2) by auto
	have inj:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> ; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	for a b
	proof-
	assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	then have \<GG>_hom_\<BB>:
	"v11 (\<GG>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>))"
	by (intro L.ft_dghm_v11_on_Hom)
	(cs_concl cs_shallow cs_intro: dg_cs_intros)+
	have "v11 (\<GG>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b))"
	proof(intro v11_vlrestriction_vsubset[OF \<GG>_hom_\<BB>] vsubsetI)
	fix g assume "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
	then obtain f where f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and g_def: "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by auto
	from f show "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_simp: g_def cs_intro: dg_cs_intros)
	qed
	then show "v11 ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	unfolding dghm_comp_components
	by (intro v11_vlrestriction_vcomp) (auto simp: R.ft_dghm_v11_on_Hom prems)
	qed
	then show "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	by (intro is_ft_dghmI, cs_concl cs_shallow cs_intro: dg_cs_intros) auto
	qed


	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_ft_dghm) ft_dghm_ArrMap_eqD:
	+ assumes "g : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	+ shows "g = f"
	+proof-
	+ from assms(1) have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
	+ interpret ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b\<close>
	+ by (rule ft_dghm_v11_on_Hom[OF a b])
	+ have dom_def: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b) = Hom \<AA> a b"
	+ by (intro vdomain_vlrestriction_vsubset vsubsetI) (auto simp: dg_cs_simps)
	+ show ?thesis
	+ proof(rule ArrMap.v11_injective[unfolded dom_def dg_cs_simps, OF assms(1,2)])
	+ from assms(1,2) show
	+ "(\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)\<lparr>g\<rparr> = (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: dg_cs_simps assms(3) vsv.vlrestriction_atI
	+ cs_intro: V_cs_intros dg_cs_intros
	+ )
	+ qed
	+qed
	+
	+

	subsection\<open>Full digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_fl_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes fl_dghm_surj_on_Hom:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"

	syntax "_is_fl_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_dghm \<alpha> \<AA> \<BB> \<FF>"


	text\<open>Rules.\<close>

	lemma (in is_fl_dghm) is_fl_dghm_axioms'[dghm_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_fl_dghm_axioms)

	mk_ide rf is_fl_dghm_def[unfolded is_fl_dghm_axioms_def]
	\|intro is_fl_dghmI\|
	\|dest is_fl_dghmD[dest]\|
	\|elim is_fl_dghmE[elim]\|

	lemmas [dghm_cs_intros] = is_fl_dghmD(1)


	subsubsection\<open>Opposite full digraph homomorphism\<close>

	lemma (in is_fl_dghm) fl_dghm_op_dghm_is_fl_dghm:
	"op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	by
	(
	rule is_fl_dghmI,
	unfold dg_op_simps,
	cs_concl cs_shallow cs_intro: dg_cs_intros dg_op_intros
	)
	(auto simp: fl_dghm_surj_on_Hom)

	lemma (in is_fl_dghm) fl_dghm_op_dghm_is_fl_dghm'[dg_op_intros]:
	assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
	shows "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	unfolding assms by (rule fl_dghm_op_dghm_is_fl_dghm)

	lemmas fl_dghm_op_dghm_is_fl_dghm[dg_op_intros] =
	is_fl_dghm.fl_dghm_op_dghm_is_fl_dghm'


	subsubsection\<open>
	The composition of full digraph homomorphisms is a full digraph homomorphism
	\<close>

	lemma dghm_comp_is_fl_dghm[dghm_cs_intros]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_fl_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_fl_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	have surj:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) =
	Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	for a b
	proof-
	assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	have surj_\<FF>: "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (rule R.fl_dghm_surj_on_Hom[OF prems])
	from prems L.is_dghm_axioms R.is_dghm_axioms have comp_Obj:
	"(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	"(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by (auto simp: dg_cs_simps)
	have "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = \<GG>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
	unfolding dghm_comp_components by (simp add: vcomp_vimage)
	also from prems have
	"\<dots> = Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding surj_\<FF> comp_Obj
	by
	(
	simp add:
	prems(2) L.fl_dghm_surj_on_Hom R.dghm_ObjMap_app_in_HomCod_Obj
	)
	finally show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) =
	Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by simp
	qed
	show ?thesis
	by (rule is_fl_dghmI, cs_concl cs_shallow cs_intro: dg_cs_intros)
	(auto simp: surj)
	qed



	subsection\<open>Fully faithful digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_ff_dghm = is_ft_dghm \<alpha> \<AA> \<BB> \<FF> + is_fl_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF>

	syntax "_is_ff_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_dghm \<alpha> \<AA> \<BB> \<FF>"


	text\<open>Rules.\<close>

	lemma (in is_ff_dghm) is_ff_dghm_axioms'[dghm_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_ff_dghm_axioms)

	mk_ide rf is_ff_dghm_def
	\|intro is_ff_dghmI\|
	\|dest is_ff_dghmD[dest]\|
	\|elim is_ff_dghmE[elim]\|

	lemmas [dghm_cs_intros] = is_ff_dghmD


	subsubsection\<open>Opposite fully faithful digraph homomorphism.\<close>

	lemma (in is_ff_dghm) ff_dghm_op_dghm_is_ff_dghm:
	"op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	by (rule is_ff_dghmI) (cs_concl cs_shallow cs_intro: dg_op_intros)+

	lemma (in is_ff_dghm) ff_dghm_op_dghm_is_ff_dghm'[dg_op_intros]:
	assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
	shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ff_dghm_op_dghm_is_ff_dghm)

	lemmas ff_dghm_op_dghm_is_ff_dghm[dg_op_intros] =
	is_ff_dghm.ff_dghm_op_dghm_is_ff_dghm


	subsubsection\<open>
	The composition of fully faithful digraph homomorphisms is
	a fully faithful digraph homomorphism.
	\<close>

	lemma dghm_comp_is_ff_dghm[dghm_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms
	by (intro is_ff_dghmI, elim is_ff_dghmE) (cs_concl cs_intro: dghm_cs_intros)



	subsection\<open>Isomorphism of digraphs\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_iso_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes iso_dghm_ObjMap_v11: "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and iso_dghm_ArrMap_v11: "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and iso_dghm_ObjMap_vrange[dghm_cs_simps]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and iso_dghm_ArrMap_vrange[dghm_cs_simps]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"

	syntax "_is_iso_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_dghm \<alpha> \<AA> \<BB> \<FF>"

	sublocale is_iso_dghm \<subseteq> ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cs_simps dg_cs_simps cs_intro: iso_dghm_ObjMap_v11
	)+

	sublocale is_iso_dghm \<subseteq> ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dghm_cs_simps dg_cs_simps cs_intro: iso_dghm_ArrMap_v11
	)+

	lemmas [dghm_cs_simps] =
	is_iso_dghm.iso_dghm_ObjMap_vrange
	is_iso_dghm.iso_dghm_ArrMap_vrange


	text\<open>Rules.\<close>

	lemma (in is_iso_dghm) is_iso_dghm_axioms'[dghm_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_dghm_axioms)

	mk_ide rf is_iso_dghm_def[unfolded is_iso_dghm_axioms_def]
	\|intro is_iso_dghmI\|
	\|dest is_iso_dghmD[dest]\|
	\|elim is_iso_dghmE[elim]\|


	text\<open>Elementary properties.\<close>

	lemma (in is_iso_dghm) iso_dghm_Obj_HomDom_if_Obj_HomCod[elim]:
	assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	obtains a where "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	using assms ObjMap.vrange_atD iso_dghm_ObjMap_vrange by blast

	lemma (in is_iso_dghm) iso_dghm_Arr_HomDom_if_Arr_HomCod[elim]:
	assumes "g \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	obtains f where "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	using assms ArrMap.vrange_atD iso_dghm_ArrMap_vrange by blast

	lemma (in is_iso_dghm) iso_dghm_ObjMap_eqE[elim]:
	assumes "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "a = b \<Longrightarrow> P"
	shows P
	using assms ObjMap.v11_eq_iff by auto

	lemma (in is_iso_dghm) iso_dghm_ArrMap_eqE[elim]:
	assumes "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "f = g \<Longrightarrow> P"
	shows P
	using assms ArrMap.v11_eq_iff by auto

	sublocale is_iso_dghm \<subseteq> is_ft_dghm
	by (intro is_ft_dghmI, cs_concl cs_shallow cs_intro: dg_cs_intros) auto

	sublocale is_iso_dghm \<subseteq> is_fl_dghm
	proof
	fix a b assume [intro]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	show "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof(intro vsubset_antisym vsubsetI)
	fix g assume prems: "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	then have g: "g : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" by auto
	then have dom_g: "\<BB>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and cod_g: "\<BB>\<lparr>Cod\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by blast+
	from prems obtain f
	where [intro, simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and g_def: "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by auto
	then obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'" by blast
	then have "g : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by (cs_concl cs_shallow cs_simp: g_def dg_cs_simps cs_intro: dg_cs_intros)
	with g have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>" and "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by (metis HomCod.dg_is_arrE cod_g)+
	with f have "a = \<AA>\<lparr>Dom\<rparr>\<lparr>f\<rparr>" "b = \<AA>\<lparr>Cod\<rparr>\<lparr>f\<rparr>" by auto (slow)
	with f show "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
	by (auto simp: g_def HomDom.dg_is_arrD(4,5) ArrMap.vsv_vimageI1)
	qed (metis ArrMap.vsv_vimageE dghm_ArrMap_is_arr' in_Hom_iff)
	qed

	sublocale is_iso_dghm \<subseteq> is_ff_dghm by unfold_locales

	lemmas (in is_iso_dghm) iso_dghm_is_ff_dghm = is_ff_dghm_axioms
	lemmas [dghm_cs_intros] = is_iso_dghm.iso_dghm_is_ff_dghm


	subsubsection\<open>Opposite digraph isomorphisms\<close>

	lemma (in is_iso_dghm) is_iso_dghm_op:
	"op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
	by (intro is_iso_dghmI, unfold dg_op_simps)
	(
	cs_concl cs_shallow
	cs_simp: dghm_cs_simps cs_intro: V_cs_intros dg_cs_intros dg_op_intros
	)+

	lemma (in is_iso_dghm) is_iso_dghm_op':
	assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
	shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_dghm_op)

	lemmas is_iso_dghm_op[dg_op_intros] = is_iso_dghm.is_iso_dghm_op'


	subsubsection\<open>
	The composition of isomorphisms of digraphs is an isomorphism of digraphs
	\<close>

	lemma dghm_comp_is_iso_dghm[dghm_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret \<FF>: is_iso_dghm \<alpha> \<AA> \<BB> \<FF> using assms by auto
	interpret \<GG>: is_iso_dghm \<alpha> \<BB> \<CC> \<GG> using assms by auto
	show ?thesis
	by (intro is_iso_dghmI, unfold dghm_comp_components)
	(
	cs_concl
	cs_simp: V_cs_simps dg_cs_simps dghm_cs_simps
	cs_intro: dg_cs_intros V_cs_intros
	)+
	qed


	subsubsection\<open>An identity digraph homomorphism is an isomorphism of digraphs.\<close>

	lemma (in digraph) dg_dghm_id_is_iso_dghm: "dghm_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule is_iso_dghmI) (simp_all add: dg_dghm_id_is_dghm dghm_id_components)

	lemma (in digraph) dg_dghm_id_is_iso_dghm'[dghm_cs_intros]:
	assumes "\<AA>' = \<CC>" and "\<BB>' = \<CC>"
	shows "dghm_id \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule dg_dghm_id_is_iso_dghm)

	lemmas [dghm_cs_intros] = digraph.dg_dghm_id_is_iso_dghm'



	subsection\<open>Inverse digraph homomorphism\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition inv_dghm :: "V \<Rightarrow> V"
	where "inv_dghm \<FF> = [(\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>, (\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>, \<FF>\<lparr>HomCod\<rparr>, \<FF>\<lparr>HomDom\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma inv_dghm_components:
	shows "inv_dghm \<FF>\<lparr>ObjMap\<rparr> = (\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>"
	and "inv_dghm \<FF>\<lparr>ArrMap\<rparr> = (\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>"
	and [dghm_cs_simps]: "inv_dghm \<FF>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	and [dghm_cs_simps]: "inv_dghm \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	unfolding inv_dghm_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma (in is_iso_dghm) inv_dghm_ObjMap_v11[dghm_cs_intros]:
	"v11 (inv_dghm \<FF>\<lparr>ObjMap\<rparr>)"
	unfolding inv_dghm_components by (cs_concl cs_shallow cs_intro: V_cs_intros)

	lemmas [dghm_cs_intros] = is_iso_dghm.inv_dghm_ObjMap_v11

	lemma (in is_iso_dghm) inv_dghm_ObjMap_vdomain[dghm_cs_simps]:
	"\<D>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	unfolding inv_dghm_components by (cs_concl cs_simp: dghm_cs_simps V_cs_simps)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_vdomain

	lemma (in is_iso_dghm) inv_dghm_ObjMap_app[dghm_cs_simps]:
	assumes "a' = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> = a"
	unfolding inv_dghm_components
	by (metis assms ObjMap.vconverse_atI ObjMap.vsv_vconverse vsv.vsv_appI)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_app

	lemma (in is_iso_dghm) inv_dghm_ObjMap_vrange[dghm_cs_simps]:
	"\<R>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	unfolding inv_dghm_components by (cs_concl cs_simp: dg_cs_simps V_cs_simps)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_vrange


	subsubsection\<open>Arrow map\<close>

	lemma (in is_iso_dghm) inv_dghm_ArrMap_v11[dghm_cs_intros]:
	"v11 (inv_dghm \<FF>\<lparr>ArrMap\<rparr>)"
	unfolding inv_dghm_components by (cs_concl cs_shallow cs_intro: V_cs_intros)

	lemmas [dghm_cs_intros] = is_iso_dghm.inv_dghm_ArrMap_v11

	lemma (in is_iso_dghm) inv_dghm_ArrMap_vdomain[dghm_cs_simps]:
	"\<D>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	unfolding inv_dghm_components by (cs_concl cs_simp: dghm_cs_simps V_cs_simps)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_vdomain

	lemma (in is_iso_dghm) inv_dghm_ArrMap_app[dghm_cs_simps]:
	assumes "a' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>a'\<rparr> = a"
	unfolding inv_dghm_components
	by (metis assms ArrMap.vconverse_atI ArrMap.vsv_vconverse vsv.vsv_appI)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_app

	lemma (in is_iso_dghm) inv_dghm_ArrMap_vrange[dghm_cs_simps]:
	"\<R>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	unfolding inv_dghm_components by (cs_concl cs_simp: dg_cs_simps V_cs_simps)

	lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_vrange


	subsubsection\<open>Further properties\<close>

	lemma (in is_iso_dghm) iso_dghm_ObjMap_inv_dghm_ObjMap_app[dghm_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "\<FF>\<lparr>ObjMap\<rparr>\<lparr>inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr> = a"
	using assms by (cs_concl cs_simp: inv_dghm_components V_cs_simps)

	lemmas [dghm_cs_simps] = is_iso_dghm.iso_dghm_ObjMap_inv_dghm_ObjMap_app

	lemma (in is_iso_dghm) iso_dghm_ArrMap_inv_dghm_ArrMap_app[dghm_cs_simps]:
	assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> = f"
	using assms
	by (cs_concl cs_simp: inv_dghm_components V_cs_simps cs_intro: dg_cs_intros)

	lemmas [dghm_cs_simps] = is_iso_dghm.iso_dghm_ArrMap_inv_dghm_ArrMap_app

	lemma (in is_iso_dghm) iso_dghm_HomDom_is_arr_conv:
	assumes "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	by
	(
	metis
	assms
	HomDom.dg_is_arrE
	is_arr_def
	dghm_ArrMap_is_arr
	iso_dghm_ObjMap_eqE
	)

	lemma (in is_iso_dghm) iso_dghm_HomCod_is_arr_conv:
	assumes "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	and "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	by
	(
	metis
	assms
	dghm_ArrMap_is_arr'
	is_arrI
	iso_dghm_ArrMap_inv_dghm_ArrMap_app
	iso_dghm_ObjMap_inv_dghm_ObjMap_app
	)



	subsection\<open>An isomorphism of digraphs is an isomorphism in the category \<open>GRPH\<close>\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	-lemma is_arr_isomorphism_is_iso_dghm:
	+lemma is_iso_arr_is_iso_dghm:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
	and "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> = dghm_id \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof(intro is_iso_dghmI)

	interpret L: is_dghm \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
	interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))

	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_shallow cs_intro: dg_cs_intros)

	show "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	proof(rule R.ObjMap.vsv_valeq_v11I)
	fix a b assume prems[simp]:
	"a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	from assms(1,2) have "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (simp add: dg_cs_simps)
	then show "a = b" by (simp add: assms(3) dghm_id_components)
	qed

	show "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	proof(rule R.ArrMap.vsv_valeq_v11I)
	fix a b
	assume prems[simp]:
	"a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>b\<rparr>"
	then have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_intro: dg_cs_intros)
	with R.dghm_ArrMap_vsv L.dghm_ArrMap_vsv R.dghm_ArrMap_vrange have
	"(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>b\<rparr>"
	unfolding dghm_comp_components by (simp add: dg_cs_simps)
	then show "a = b" by (simp add: assms(3) dghm_id_components)
	qed

	show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	from R.dghm_ObjMap_vrange show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<Longrightarrow> a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for a
	by auto
	next
	fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	then have a_def[symmetric]: "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = a"
	unfolding assms(4) dghm_id_components by simp
	from prems show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	by (subst a_def)
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros dg_cs_intros cs_simp: dg_cs_simps
	)
	qed

	show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	from R.dghm_ArrMap_vrange show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<Longrightarrow> a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" for a
	by auto
	next
	fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
	then have a_def[symmetric]: "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = a"
	unfolding assms(4) dghm_id_components by simp
	with prems show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	by (subst a_def)
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros dg_cs_intros cs_simp: dg_cs_simps
	)
	qed

	qed

	-lemma is_iso_dghm_is_arr_isomorphism:
	+lemma is_iso_dghm_is_iso_arr:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [dghm_cs_intros]: "inv_dghm \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	- and "inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
	- and "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF> = dghm_id \<BB>"
	+ and [dghm_cs_simps]: "inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
	+ and [dghm_cs_simps]: "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF> = dghm_id \<BB>"
	proof-

	let ?\<GG> = \<open>inv_dghm \<FF>\<close>

	interpret is_iso_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))

	show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_iso_dghmI is_dghmI, unfold dghm_cs_simps)
	show "vfsequence (inv_dghm \<FF>)" unfolding inv_dghm_def by auto
	show "vcard (inv_dghm \<FF>) = 4\<^sub>\<nat>"
	unfolding inv_dghm_def by (simp add: nat_omega_simps)
	show "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f
	using that
	by
	(
	intro iso_dghm_HomDom_is_arr_conv,
	use nothing in \<open>unfold inv_dghm_components\<close>
	)
	(
	cs_concl
	cs_simp: V_cs_simps dghm_cs_simps dg_cs_simps
	cs_intro: dg_cs_intros V_cs_intros
	)+
	qed
	(
	cs_concl cs_shallow
	cs_simp: dg_cs_simps
	cs_intro: dg_cs_intros V_cs_intros dghm_cs_intros
	)+

	show "inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
	proof(rule dghm_eqI[of \<alpha> \<AA> \<AA> _ \<AA> \<AA>])
	show "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = dghm_id \<AA>\<lparr>ObjMap\<rparr>"
	unfolding inv_dghm_components dghm_comp_components dghm_id_components
	by (rule ObjMap.v11_vcomp_vconverse)
	show "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = dghm_id \<AA>\<lparr>ArrMap\<rparr>"
	unfolding inv_dghm_components dghm_comp_components dghm_id_components
	by (rule ArrMap.v11_vcomp_vconverse)
	qed (use \<GG> in \<open>cs_concl cs_intro: dghm_cs_intros\<close>)

	show "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF> = dghm_id \<BB>"
	proof(rule dghm_eqI[of \<alpha> \<BB> \<BB> _ \<BB> \<BB>])
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF>)\<lparr>ObjMap\<rparr> = dghm_id \<BB>\<lparr>ObjMap\<rparr>"
	unfolding inv_dghm_components dghm_comp_components dghm_id_components
	by (rule ObjMap.v11_vcomp_vconverse')
	show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF>)\<lparr>ArrMap\<rparr> = dghm_id \<BB>\<lparr>ArrMap\<rparr>"
	unfolding inv_dghm_components dghm_comp_components dghm_id_components
	by (rule ArrMap.v11_vcomp_vconverse')
	qed (use \<GG> in \<open>cs_concl cs_intro: dghm_cs_intros\<close>)

	qed


	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_iso_dghm) iso_inv_dghm_ObjMap_dghm_ObjMap_app[dghm_cs_simps]:
	+ assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ shows "inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr> = a"
	+proof-
	+ from is_iso_dghm_is_iso_arr[OF is_iso_dghm_axioms] have
	+ "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = dghm_id \<AA>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by simp
	+ from this assms show ?thesis
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: dg_cs_simps cs_intro: dg_cs_intros dghm_cs_intros
	+ )
	+qed
	+
	+lemmas [dghm_cs_simps] = is_iso_dghm.iso_inv_dghm_ObjMap_dghm_ObjMap_app
	+
	+lemma (in is_iso_dghm) iso_inv_dghm_ArrMap_dghm_ArrMap_app[dghm_cs_simps]:
	+ assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	+ shows "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> = f"
	+proof-
	+ from is_iso_dghm_is_iso_arr[OF is_iso_dghm_axioms] have
	+ "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = dghm_id \<AA>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	+ by simp
	+ from this assms show ?thesis
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: dg_cs_simps cs_intro: dg_cs_intros dghm_cs_intros
	+ )
	+qed
	+
	+lemmas [dghm_cs_simps] = is_iso_dghm.iso_inv_dghm_ArrMap_dghm_ArrMap_app
	+
	+

	subsection\<open>Isomorphic digraphs\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale iso_digraph =
	fixes \<alpha> \<AA> \<BB> :: V
	assumes iso_digraph_is_iso_dghm: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"

	notation iso_digraph (infixl "\<approx>\<^sub>D\<^sub>G\<index>" 50)

	sublocale iso_digraph \<subseteq> HomDom: digraph \<alpha> \<AA> + HomCod: digraph \<alpha> \<BB>
	using iso_digraph_is_iso_dghm by auto


	text\<open>Rules.\<close>

	lemma iso_digraphI':
	assumes "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms iso_digraph.intro by auto

	lemma iso_digraphI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_digraph_def by auto

	lemma iso_digraphD[dest]:
	assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms unfolding iso_digraph_def by simp_all

	lemma iso_digraphE[elim]:
	assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by auto


	subsubsection\<open>A digraph isomorphism is an equivalence relation\<close>

	lemma iso_digraph_refl:
	assumes "digraph \<alpha> \<AA>"
	shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule iso_digraphI[of _ _ _ \<open>dghm_id \<AA>\<close>])
	interpret digraph \<alpha> \<AA> by (rule assms)
	show "dghm_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" by (rule dg_dghm_id_is_iso_dghm)
	qed

	lemma iso_digraph_sym[sym]:
	assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<BB> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret iso_digraph \<alpha> \<AA> \<BB> by (rule assms)
	from iso_digraph_is_iso_dghm obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then have "inv_dghm \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	- by (simp add: is_iso_dghm_is_arr_isomorphism(1))
	+ by (simp add: is_iso_dghm_is_iso_arr(1))
	then show ?thesis
	by (cs_concl cs_shallow cs_intro: dghm_cs_intros iso_digraphI)
	qed

	lemma iso_digraph_trans[trans]:
	assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: iso_digraph \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret R: iso_digraph \<alpha> \<BB> \<CC> by (rule assms(2))
	from L.iso_digraph_is_iso_dghm R.iso_digraph_is_iso_dghm show ?thesis
	by (meson dghm_comp_is_iso_dghm iso_digraph.intro)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Digraph.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Digraph.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Digraph.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Digraph.thy
	@@ -1,558 +1,558 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Digraph\label{sec:digraph}\<close>
	theory CZH_DG_Digraph
	imports CZH_DG_Introduction
	begin



	subsection\<open>Background\<close>

	named_theorems dg_field_simps

	definition Obj :: V where [dg_field_simps]: "Obj = 0"
	definition Arr :: V where [dg_field_simps]: "Arr = 1\<^sub>\<nat>"
	definition Dom :: V where [dg_field_simps]: "Dom = 2\<^sub>\<nat>"
	definition Cod :: V where [dg_field_simps]: "Cod = 3\<^sub>\<nat>"



	subsection\<open>Arrow with a domain and a codomain\<close>


	text\<open>
	The definition of and notation for an arrow with a domain and codomain is
	adapted from Chapter I-1 in \cite{mac_lane_categories_2010}.
	The definition is applicable to digraphs and all other relevant derived
	entities, such as semicategories and categories, that are presented in
	the subsequent chapters.

	In this work, by convention, the definition of an arrow with a domain and a
	codomain is nearly always preferred to the explicit use of the domain
	and codomain functions for the specification of the fundamental properties
	of arrows.
	Thus, to say that \<open>f\<close> is an arrow with the domain \<open>a\<close>, it is preferable
	to write \<open>f : a \<mapsto>\<^bsub>\<CC>\<^esub> b\<close> (\<open>b\<close> can be assumed to be arbitrary) instead
	of \<^term>\<open>f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>\<close> and \<^term>\<open>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a\<close>.
	\<close>

	definition is_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_arr \<CC> a b f \<longleftrightarrow> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a \<and> \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = b"

	syntax "_is_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool" (\<open>_ : _ \<mapsto>\<index> _\<close> [51, 51, 51] 51)
	translations "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_arr \<CC> a b f"


	text\<open>Rules.\<close>

	mk_ide is_arr_def
	\|intro is_arrI\|
	\|dest is_arrD[dest]\|
	\|elim is_arrE[elim]\|

	lemmas [dg_shared_cs_intros, dg_cs_intros] = is_arrD(1)
	lemmas [dg_shared_cs_simps, dg_cs_simps] = is_arrD(2,3)



	subsection\<open>\<open>Hom\<close>-set\<close>


	text\<open>See Chapter I-8 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation Hom :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "Hom \<CC> a b \<equiv> set {f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}"

	lemma small_Hom[simp]: "small {f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}" unfolding is_arr_def by simp


	text\<open>Rules.\<close>

	lemma HomI[dg_shared_cs_intros, dg_cs_intros]:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "f \<in>\<^sub>\<circ> Hom \<CC> a b"
	using assms by auto

	lemma in_Hom_iff[dg_shared_cs_simps, dg_cs_simps]:
	"f \<in>\<^sub>\<circ> Hom \<CC> a b \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by simp


	text\<open>
	The \<open>Hom\<close>-sets in a given digraph are pairwise disjoint. This property
	was exposed as Axiom (v) in an alternative definition of a category presented
	in Chapter I-8 in \cite{mac_lane_categories_2010}. Within the scope of the
	definitional framework employed in this study, this property holds
	unconditionally.
	\<close>

	lemma Hom_vdisjnt:
	assumes "a \<noteq> a' \<or> b \<noteq> b'"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "vdisjnt (Hom \<CC> a b) (Hom \<CC> a' b')"
	proof(intro vdisjntI, unfold in_Hom_iff)
	fix g f assume "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "f : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	then have "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "\<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = a"
	and "\<CC>\<lparr>Cod\<rparr>\<lparr>g\<rparr> = b"
	and "\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a'"
	and "\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = b'"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
	with assms(1) have "\<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> \<noteq> \<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> \<or> \<CC>\<lparr>Cod\<rparr>\<lparr>g\<rparr> \<noteq> \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>" by auto
	then show "g \<noteq> f" by clarsimp
	qed



	subsection\<open>Digraph: background information\<close>


	text\<open>
	The definition of a digraph that is employed in this work is similar
	to the definition of a \<open>directed graph\<close> presented in Chapter I-2 in
	\cite{mac_lane_categories_2010}. However, there are notable differences.
	More specifically, the definition is parameterized by a limit ordinal \<open>\<alpha>\<close>,
	such that \<open>\<omega> < \<alpha>\<close>; the set of objects is assumed to be a subset
	of the set \<open>V\<^sub>\<alpha>\<close> in the von Neumann hierarchy of sets (e.g.,
	see \cite{takeuti_introduction_1971}). Such digraphs are called \<open>\<alpha>\<close>-\<open>digraphs\<close>
	to make the dependence on the parameter \<open>\<alpha>\<close> explicit.\footnote{
	The prefix ``\<open>\<alpha>\<close>-'' may be omitted whenever it is possible to infer the value
	of \<open>\<alpha>\<close> from the context. This applies not only to the digraphs, but all
	other entities that are parameterized by a limit ordinal \<open>\<alpha>\<close> such that
	\<open>\<omega> < \<alpha>\<close>.} This definition was inspired by the ideas expressed in
	\cite{feferman_set-theoretical_1969}, \cite{sica_doing_2006} and
	\cite{shulman_set_2008}.

	In ZFC in HOL, the predicate \<^term>\<open>small\<close> is used for distinguishing the
	terms of any type of the form \<^typ>\<open>'a set\<close> that are isomorphic to elements
	of a term of the type \<^typ>\<open>V\<close> (the elements can be exposed via the predicate
	\<^const>\<open>elts\<close>). Thus, the collection of the elements associated with any term of
	the type \<^typ>\<open>V\<close> (e.g., \<^term>\<open>elts (a::V)\<close>) is always small
	(see the theorem @{thm [source] small_elts} in \cite{paulson_zermelo_2019}).
	Therefore, in this study, in an attempt to avoid confusion, the term ``small''
	is never used to refer to digraphs.
	Instead, a new terminology is introduced in this body of work.

	Thus, in this work, an \<open>\<alpha>\<close>-digraph is a tiny \<open>\<alpha>\<close>-digraph if and only if
	the set of its objects and the set of its arrows both belong to the set \<open>V\<^sub>\<alpha>\<close>.
	This notion is similar to the notion of a small category in the sense of
	the definition employed in Chapter I-6 in \cite{mac_lane_categories_2010},
	if it is assumed that the ``smallness'' is determined with respect to the
	set \<open>V\<^sub>\<alpha>\<close> instead of the universe \<open>U\<close>. Also, in what follows, any member of
	the set \<open>V\<^sub>\<alpha>\<close> will be referred to as an \<open>\<alpha>\<close>-tiny set.

	All of the large (i.e. non-tiny) digraphs
	that are considered within the scope of this work have a slightly
	unconventional condition associated with the size of their \<open>Hom\<close>-sets.
	This condition implies that all \<open>Hom\<close>-sets of a digraph
	are tiny, but it is not equivalent to
	all \<open>Hom\<close>-sets being tiny. The condition was introduced in an attempt to
	resolve some of the issues related to the lack of an analogue of the
	Axiom Schema of Replacement closed with respect to \<open>V\<^sub>\<alpha>\<close>.
	\<close>



	subsection\<open>Digraph: definition and elementary properties\<close>

	locale digraph = \<Z> \<alpha> + vfsequence \<CC> + Dom: vsv \<open>\<CC>\<lparr>Dom\<rparr>\<close> + Cod: vsv \<open>\<CC>\<lparr>Cod\<rparr>\<close>
	for \<alpha> \<CC> +
	assumes dg_length[dg_cs_simps]: "vcard \<CC> = 4\<^sub>\<nat>"
	and dg_Dom_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and dg_Dom_vrange: "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and dg_Cod_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and dg_Cod_vrange: "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and dg_Obj_vsubset_Vset: "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and dg_Hom_vifunion_in_Vset[dg_cs_intros]:
	"\<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"

	lemmas [dg_cs_simps] =
	digraph.dg_length
	digraph.dg_Dom_vdomain
	digraph.dg_Cod_vdomain

	lemmas [dg_cs_intros] =
	digraph.dg_Hom_vifunion_in_Vset


	text\<open>Rules.\<close>

	lemma (in digraph) digraph_axioms'[dg_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "digraph \<alpha>' \<CC>"
	unfolding assms by (rule digraph_axioms)

	mk_ide rf digraph_def[unfolded digraph_axioms_def]
	\|intro digraphI\|
	\|dest digraphD[dest]\|
	\|elim digraphE[elim]\|


	text\<open>Elementary properties.\<close>

	lemma dg_eqI:
	assumes "digraph \<alpha> \<AA>"
	and "digraph \<alpha> \<BB>"
	and "\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	and "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	and "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>: digraph \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: digraph \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<AA> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: V_cs_simps dg_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<AA> \<Longrightarrow> \<AA>\<lparr>a\<rparr> = \<BB>\<lparr>a\<rparr>" for a
	by (unfold dom_lhs, elim_in_numeral, insert assms)
	(auto simp: dg_field_simps)
	qed
	(
	cs_concl cs_shallow
	cs_simp: V_cs_simps dg_cs_simps cs_intro: V_cs_intros
	)+
	qed

	lemma (in digraph) dg_def: "\<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<CC> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: V_cs_simps dg_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<CC> = \<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<CC> \<Longrightarrow> \<CC>\<lparr>a\<rparr> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" for a
	by (unfold dom_lhs, elim_in_numeral, unfold dg_field_simps)
	(simp_all add: nat_omega_simps)
	qed (auto simp: vsv_axioms)

	lemma (in digraph) dg_Obj_if_Dom_vrange:
	assumes "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>)"
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms dg_Dom_vrange by auto

	lemma (in digraph) dg_Obj_if_Cod_vrange:
	assumes "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>)"
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms dg_Cod_vrange by auto

	lemma (in digraph) dg_is_arrD:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a"
	and "\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = b"
	proof-
	from assms show prems: "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and fa[symmetric]: "\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a"
	and fb[symmetric]: "\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = b"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
	from digraph_axioms prems have "f \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>)" "f \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>)"
	by (cs_concl cs_shallow cs_simp: dg_cs_simps)+
	with assms show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_intro: dg_Obj_if_Dom_vrange dg_Obj_if_Cod_vrange V_cs_intros
	cs_simp: fa fb
	)+
	qed

	lemmas [dg_cs_intros] = digraph.dg_is_arrD(1-3)

	lemma (in digraph) dg_is_arrE[elim]:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	obtains "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a"
	and "\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = b"
	using assms by (blast dest: dg_is_arrD)

	lemma (in digraph) dg_in_ArrE[elim]:
	assumes "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	obtains a b where "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms by (auto dest: dg_is_arrD(2,3) is_arrI)

	lemma (in digraph) dg_Hom_in_Vset[dg_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "Hom \<CC> a b \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	let ?A = \<open>set {a}\<close> and ?B = \<open>set {b}\<close>
	from assms have A: "?A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and B: "?B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	from assms dg_Obj_vsubset_Vset have "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	then have a: "set {a} \<in>\<^sub>\<circ> Vset \<alpha>" and b: "set {b} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (metis Axiom_of_Pairing insert_absorb2)+
	from dg_Hom_vifunion_in_Vset[OF A B a b] show "Hom \<CC> a b \<in>\<^sub>\<circ> Vset \<alpha>" by simp
	qed

	lemmas [dg_cs_intros] = digraph.dg_Hom_in_Vset


	text\<open>Size.\<close>

	lemma (in digraph) dg_Arr_vsubset_Vset: "\<CC>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix f assume "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	then obtain a b
	where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by blast
	show "f \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule Vset_trans, rule HomI[OF f], rule dg_Hom_in_Vset[OF a b])
	qed

	lemma (in digraph) dg_Dom_vsubset_Vset: "\<CC>\<lparr>Dom\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	rule Dom.vbrelation_Limit_vsubset_VsetI,
	unfold dg_cs_simps,
	insert dg_Dom_vrange dg_Obj_vsubset_Vset
	)
	(auto intro!: dg_Arr_vsubset_Vset)

	lemma (in digraph) dg_Cod_vsubset_Vset: "\<CC>\<lparr>Cod\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	rule Cod.vbrelation_Limit_vsubset_VsetI,
	unfold dg_cs_simps,
	insert dg_Cod_vrange dg_Obj_vsubset_Vset
	)
	(auto intro!: dg_Arr_vsubset_Vset)

	lemma (in digraph) dg_digraph_in_Vset_4: "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], dg_cs_intros] =
	dg_Obj_vsubset_Vset
	dg_Arr_vsubset_Vset
	dg_Dom_vsubset_Vset
	dg_Cod_vsubset_Vset
	show ?thesis
	by (subst dg_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps
	cs_intro: dg_cs_intros V_cs_intros
	)
	qed

	lemma (in digraph) dg_Obj_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms dg_Obj_vsubset_Vset Vset_in_mono by auto

	lemma (in digraph) dg_in_Obj_in_Vset[dg_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms dg_Obj_vsubset_Vset by auto

	lemma (in digraph) dg_Arr_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using assms dg_Arr_vsubset_Vset Vset_in_mono by auto

	lemma (in digraph) dg_in_Arr_in_Vset[dg_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms dg_Arr_vsubset_Vset by auto

	lemma (in digraph) dg_Dom_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>Dom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (meson assms dg_Dom_vsubset_Vset Vset_in_mono vsubset_in_VsetI)

	lemma (in digraph) dg_Cod_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>Cod\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (meson assms dg_Cod_vsubset_Vset Vset_in_mono vsubset_in_VsetI)

	lemma (in digraph) dg_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [dg_cs_intros] =
	dg_Obj_in_Vset dg_Arr_in_Vset dg_Dom_in_Vset dg_Cod_in_Vset
	from assms(2) show ?thesis
	by (subst dg_def)
	(cs_concl cs_shallow cs_intro: dg_cs_intros V_cs_intros)
	qed

	lemma (in digraph) dg_digraph_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "digraph \<beta> \<CC>"
	proof(rule digraphI)
	show "vfsequence \<CC>" by (simp add: vfsequence_axioms)
	show "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<beta>"
	by (rule vsubsetI)
	(meson Vset_in_mono Vset_trans assms(2) dg_Obj_vsubset_Vset vsubsetE)
	fix A B assume "A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "A \<in>\<^sub>\<circ> Vset \<beta>" "B \<in>\<^sub>\<circ> Vset \<beta>"
	then have "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by auto
	moreover note dg_Arr_vsubset_Vset
	moreover have "Vset \<alpha> \<in>\<^sub>\<circ> Vset \<beta>" by (simp add: Vset_in_mono assms(2))
	ultimately show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<beta>" by auto
	qed (auto simp: assms(1) dg_Dom_vrange dg_Cod_vrange dg_cs_simps)

	lemma small_digraph[simp]: "small {\<CC>. digraph \<alpha> \<CC>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	with digraph.dg_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>] subsetI)
	(auto simp: \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<CC>. digraph \<alpha> \<CC>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in \<Z>) digraphs_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "set {\<CC>. digraph \<alpha> \<CC>} \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "set {\<CC>. digraph \<alpha> \<CC>} \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<CC> assume "\<CC> \<in>\<^sub>\<circ> set {\<CC>. digraph \<alpha> \<CC>}"
	then interpret digraph \<alpha> \<CC> by simp
	show "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	unfolding VPow_iff by (rule dg_digraph_in_Vset_4)
	qed
	from assms(2) show "Vset (\<alpha> + 4\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma digraph_if_digraph:
	assumes "digraph \<beta> \<CC>"
	and "\<Z> \<alpha>"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "digraph \<alpha> \<CC>"
	proof-
	interpret digraph \<beta> \<CC> by (rule assms(1))
	interpret \<alpha>: \<Z> \<alpha> by (rule assms(2))
	show ?thesis
	proof(intro digraphI)
	show "vfsequence \<CC>" by (simp add: vfsequence_axioms)
	show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	if "A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "A \<in>\<^sub>\<circ> Vset \<alpha>" "B \<in>\<^sub>\<circ> Vset \<alpha>" for A B
	by (rule assms(4)[OF that])
	qed (auto simp: assms(3) dg_Cod_vrange dg_cs_simps intro!: dg_Dom_vrange)
	qed


	-text\<open>Further elementary properties.\<close>
	+text\<open>Further properties.\<close>

	lemma (in digraph) dg_Dom_app_in_Obj:
	assumes "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms dg_Dom_vrange by (auto simp: Dom.vsv_vimageI2)

	lemma (in digraph) dg_Cod_app_in_Obj:
	assumes "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	shows "\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	using assms dg_Cod_vrange by (auto simp: Cod.vsv_vimageI2)

	lemma (in digraph) dg_Arr_vempty_if_Obj_vempty:
	assumes "\<CC>\<lparr>Obj\<rparr> = 0"
	shows "\<CC>\<lparr>Arr\<rparr> = 0"
	by (metis assms eq0_iff dg_Cod_app_in_Obj)

	lemma (in digraph) dg_Dom_vempty_if_Arr_vempty:
	assumes "\<CC>\<lparr>Arr\<rparr> = 0"
	shows "\<CC>\<lparr>Dom\<rparr> = 0"
	using assms Dom.vdomain_vrange_is_vempty
	by (auto intro: Dom.vsv_vrange_vempty simp: dg_cs_simps)

	lemma (in digraph) dg_Cod_vempty_if_Arr_vempty:
	assumes "\<CC>\<lparr>Arr\<rparr> = 0"
	shows "\<CC>\<lparr>Cod\<rparr> = 0"
	using assms Cod.vdomain_vrange_is_vempty
	by (auto intro: Cod.vsv_vrange_vempty simp: dg_cs_simps)



	subsection\<open>Opposite digraph\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_dg :: "V \<Rightarrow> V"
	where "op_dg \<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Dom\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_dg_components[dg_op_simps]:
	shows "op_dg \<CC>\<lparr>Obj\<rparr> = \<CC>\<lparr>Obj\<rparr>"
	and "op_dg \<CC>\<lparr>Arr\<rparr> = \<CC>\<lparr>Arr\<rparr>"
	and "op_dg \<CC>\<lparr>Dom\<rparr> = \<CC>\<lparr>Cod\<rparr>"
	and "op_dg \<CC>\<lparr>Cod\<rparr> = \<CC>\<lparr>Dom\<rparr>"
	unfolding op_dg_def dg_field_simps by (auto simp: nat_omega_simps)

	lemma op_dg_component_intros[dg_op_intros]:
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> a \<in>\<^sub>\<circ> op_dg \<CC>\<lparr>Obj\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<Longrightarrow> f \<in>\<^sub>\<circ> op_dg \<CC>\<lparr>Arr\<rparr>"
	unfolding dg_op_simps by simp_all


	text\<open>Elementary properties.\<close>

	lemma op_dg_is_arr[dg_op_simps]: "f : b \<mapsto>\<^bsub>op_dg \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding dg_op_simps is_arr_def by auto

	lemmas [dg_op_intros] = op_dg_is_arr[THEN iffD2]

	lemma op_dg_Hom[dg_op_simps]: "Hom (op_dg \<CC>) a b = Hom \<CC> b a"
	unfolding dg_op_simps by simp


	subsubsection\<open>Further properties\<close>

	lemma (in digraph) digraph_op[dg_op_intros]: "digraph \<alpha> (op_dg \<CC>)"
	proof(intro digraphI, unfold op_dg_components dg_op_simps)
	show "vfsequence (op_dg \<CC>)" unfolding op_dg_def by simp
	show "vcard (op_dg \<CC>) = 4\<^sub>\<nat>"
	unfolding op_dg_def by (simp add: nat_omega_simps)
	fix A B assume "A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "A \<in>\<^sub>\<circ> Vset \<alpha>" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	then show "\<Union>\<^sub>\<circ>((\<lambda>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>((\<lambda>aa\<in>\<^sub>\<circ>B. Hom \<CC> aa a) `\<^sub>\<circ> B)) `\<^sub>\<circ> A) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (subst vifunion_vifunion_flip) (intro dg_Hom_vifunion_in_Vset)
	qed (auto simp: dg_Dom_vrange dg_Cod_vrange dg_Obj_vsubset_Vset dg_cs_simps)

	lemmas digraph_op[dg_op_intros] = digraph.digraph_op

	lemma (in digraph) dg_op_dg_op_dg[dg_op_simps]: "op_dg (op_dg \<CC>) = \<CC>"
	by (rule dg_eqI[of \<alpha>], unfold dg_op_simps)
	(simp_all add: digraph_axioms digraph.digraph_op digraph_op)

	lemmas dg_op_dg_op_dg[dg_op_simps] = digraph.dg_op_dg_op_dg

	lemma eq_op_dg_iff[dg_op_simps]:
	assumes "digraph \<alpha> \<AA>" and "digraph \<alpha> \<BB>"
	shows "op_dg \<AA> = op_dg \<BB> \<longleftrightarrow> \<AA> = \<BB>"
	proof
	interpret \<AA>: digraph \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: digraph \<alpha> \<BB> by (rule assms(2))
	assume prems: "op_dg \<AA> = op_dg \<BB>"
	show "\<AA> = \<BB>"
	proof(rule dg_eqI[of \<alpha>])
	from prems show
	"\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>" "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>" "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>" "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	by (metis prems \<AA>.dg_op_dg_op_dg \<BB>.dg_op_dg_op_dg)+
	qed (simp_all add: assms)
	qed auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_GRPH.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_GRPH.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_GRPH.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_GRPH.thy
	@@ -1,147 +1,147 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>GRPH\<close> as a digraph\<close>
	theory CZH_DG_GRPH
	imports
	CZH_DG_DGHM
	CZH_DG_Small_Digraph
	begin



	subsection\<open>Background\<close>


	text\<open>
	Conventionally, \<open>GRPH\<close> defined as a category of digraphs and digraph
	homomorphisms (e.g., see Chapter II-7 in \cite{mac_lane_categories_2010}).
	However, there is little that can prevent one from exposing \<open>GRPH\<close>
	-as a digraph and provide additional structure gradually in
	-subsequent installments of this work. Thus, in this section, \<open>\<alpha>\<close>-\<open>GRPH\<close> is
	+as a digraph and provide additional structure gradually later.
	+Thus, in this section, \<open>\<alpha>\<close>-\<open>GRPH\<close> is
	defined as a digraph of digraphs and digraph homomorphisms in \<open>V\<^sub>\<alpha>\<close>.
	\<close>

	named_theorems GRPH_cs_simps
	named_theorems GRPH_cs_intros



	subsection\<open>Definition and elementary properties\<close>

	definition dg_GRPH :: "V \<Rightarrow> V"
	where "dg_GRPH \<alpha> =
	[
	set {\<CC>. digraph \<alpha> \<CC>},
	all_dghms \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_GRPH_components:
	shows "dg_GRPH \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. digraph \<alpha> \<CC>}"
	and "dg_GRPH \<alpha>\<lparr>Arr\<rparr> = all_dghms \<alpha>"
	and "dg_GRPH \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "dg_GRPH \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	unfolding dg_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)



	subsection\<open>Object\<close>

	lemma dg_GRPH_ObjI:
	assumes "digraph \<alpha> \<AA>"
	shows "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
	using assms unfolding dg_GRPH_components by auto

	lemma dg_GRPH_ObjD:
	assumes "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
	shows "digraph \<alpha> \<AA>"
	using assms unfolding dg_GRPH_components by auto

	lemma dg_GRPH_ObjE:
	assumes "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
	obtains "digraph \<alpha> \<AA>"
	using assms unfolding dg_GRPH_components by auto

	lemma dg_GRPH_Obj_iff[GRPH_cs_simps]:
	"\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> digraph \<alpha> \<AA>"
	unfolding dg_GRPH_components by auto



	subsection\<open>Domain\<close>

	mk_VLambda dg_GRPH_components(3)
	\|vsv dg_GRPH_Dom_vsv[GRPH_cs_intros]\|
	\|vdomain dg_GRPH_Dom_vdomain[GRPH_cs_simps]\|
	\|app dg_GRPH_Dom_app[GRPH_cs_simps]\|

	lemma dg_GRPH_Dom_vrange: "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_GRPH_components by (rule vrange_VLambda_vsubset) auto



	subsection\<open>Codomain\<close>

	mk_VLambda dg_GRPH_components(4)
	\|vsv dg_GRPH_Cod_vsv[GRPH_cs_intros]\|
	\|vdomain dg_GRPH_Cod_vdomain[GRPH_cs_simps]\|
	\|app dg_GRPH_Cod_app[GRPH_cs_simps]\|

	lemma dg_GRPH_Cod_vrange: "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_GRPH_components by (rule vrange_VLambda_vsubset) auto



	subsection\<open>\<open>GRPH\<close> is a digraph\<close>

	lemma (in \<Z>) tiny_digraph_dg_GRPH:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_digraph \<beta> (dg_GRPH \<alpha>)"
	proof(intro tiny_digraphI)
	show "vfsequence (dg_GRPH \<alpha>)" unfolding dg_GRPH_def by simp
	show "vcard (dg_GRPH \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_GRPH_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_GRPH_Dom_vrange)
	show "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_GRPH_Cod_vrange)
	show "dg_GRPH \<alpha>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_GRPH_components by (rule digraphs_in_Vset[OF assms])
	show "dg_GRPH \<alpha>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	unfolding dg_GRPH_components by (rule all_dghms_in_Vset[OF assms])
	qed (auto simp: assms dg_GRPH_components)



	subsection\<open>Arrow with a domain and a codomain\<close>

	lemma dg_GRPH_is_arrI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
	proof(intro is_arrI; unfold dg_GRPH_components)
	from assms show "\<FF> \<in>\<^sub>\<circ> all_dghms \<alpha>" by auto
	with assms show
	"(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)\<lparr>\<FF>\<rparr> = \<AA>"
	"(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)\<lparr>\<FF>\<rparr> = \<BB>"
	by (auto simp: GRPH_cs_simps)
	qed

	lemma dg_GRPH_is_arrD:
	assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (elim is_arrE) (auto simp: dg_GRPH_components)

	lemma dg_GRPH_is_arrE:
	assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by (simp add: dg_GRPH_is_arrD)

	lemma dg_GRPH_is_arr_iff[GRPH_cs_simps]:
	"\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	by (auto intro: dg_GRPH_is_arrI dest: dg_GRPH_is_arrD)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Introduction.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Introduction.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Introduction.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Introduction.thy
	@@ -1,419 +1,489 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	chapter\<open>Digraphs\<close>

	section\<open>Introduction\<close>
	theory CZH_DG_Introduction
	imports
	"HOL-Library.Rewrite"
	CZH_Sets_NOP
	CZH_Sets_VNHS
	begin



	subsection\<open>Background\<close>


	text\<open>
	Many concepts that are normally associated with category theory can be
	generalized to directed graphs. It is the goal of
	this chapter to expose these generalized concepts and provide the
	relevant foundations for the development of the notion of a semicategory
	in the next chapter.
	It is important to note, however, that it is not the goal of this chapter
	to present a comprehensive canonical theory of directed graphs.
	Nonetheless, there is little that could prevent one from extending this
	body of work by providing canonical results from the theory of directed
	graphs.
	\<close>



	subsection\<open>Preliminaries\<close>

	declare One_nat_def[simp del]

	named_theorems slicing_simps
	named_theorems slicing_commute
	named_theorems slicing_intros

	named_theorems dg_op_simps
	named_theorems dg_op_intros

	named_theorems dg_cs_simps
	named_theorems dg_cs_intros

	named_theorems dg_shared_cs_simps
	named_theorems dg_shared_cs_intros



	subsection\<open>CS setup for foundations\<close>

	named_theorems V_cs_simps
	named_theorems V_cs_intros

	named_theorems Ord_cs_simps
	named_theorems Ord_cs_intros


	-subsubsection\<open>\<open>HOL\<close>\<close>
	+subsubsection\<open>Basic \<open>HOL\<close>\<close>

	lemma (in semilattice_sup) sup_commute':
	shows "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<squnion> b = b' \<squnion> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<squnion> b' = b \<squnion> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a' \<squnion> b = b' \<squnion> a"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<squnion> b' = b \<squnion> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a' \<squnion> b' = b \<squnion> a"
	by (auto simp: sup.commute)

	lemma (in semilattice_inf) inf_commute':
	shows "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<sqinter> b = b' \<sqinter> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<sqinter> b' = b \<sqinter> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a' \<sqinter> b = b' \<sqinter> a"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a \<sqinter> b' = b \<sqinter> a'"
	and "b' = b \<Longrightarrow> a' = a \<Longrightarrow> a' \<sqinter> b' = b \<sqinter> a"
	by (auto simp: inf.commute)

	lemmas [V_cs_simps] =
	if_P
	if_not_P
	inf.absorb1
	inf.absorb2
	sup.absorb1
	sup.absorb2
	add_0_right
	add_0

	lemmas [V_cs_intros] =
	+ conjI
	sup_commute'
	inf_commute'
	sup.commute
	inf.commute


	+subsubsection\<open>Lists for \<open>HOL\<close>\<close>
	+
	+lemma list_all_singleton: "list_all P [x] = P x" by simp
	+
	+lemma replicate_one: "replicate 1 x = [x]"
	+ by (simp add: One_nat_def)
	+
	+lemma list_all_mono:
	+ assumes "list_all P xs" and "P \<le> Q"
	+ shows "list_all Q xs"
	+ using assms by (metis list.pred_mono_strong rev_predicate1D)
	+
	+lemma pred_in_set_mono:
	+ assumes "S \<subseteq> T"
	+ shows "(\<lambda>x. x \<in> S) \<le> (\<lambda>x. x \<in> T)"
	+ using assms by auto
	+
	+lemma elts_subset_mono:
	+ assumes "S \<subseteq>\<^sub>\<circ> T"
	+ shows "elts S \<subseteq> elts T"
	+ using assms by auto
	+
	+lemma list_all_replicate:
	+ assumes "P x"
	+ shows "list_all P (replicate n x)"
	+ using assms by (metis Ball_set in_set_replicate)
	+
	+lemma list_all_set:
	+ assumes "list_all P xs" and "x \<in> list.set xs"
	+ shows "P x"
	+ using assms by (induct xs) auto
	+
	+lemma list_map_id:
	+ assumes "list_all (\<lambda>x. f x = x) xs"
	+ shows "map f xs = xs"
	+ using assms by (induct xs) auto
	+
	+lemmas [V_cs_simps] =
	+ List.append.append_Nil
	+ List.append_Nil2
	+ List.append.append_Cons
	+ List.rev.simps(1)
	+ list.map(1,2)
	+ rev.simps(2)
	+ List.map_append
	+ list_all_append
	+ replicate.replicate_0
	+ rev_replicate
	+ semiring_1_class.of_nat_0
	+ group_add_class.minus_zero
	+ group_add_class.minus_minus
	+ replicate.replicate_Suc
	+ replicate_one
	+ list_all_singleton
	+
	+lemmas [V_cs_intros] =
	+ exI
	+ pred_in_set_mono
	+ elts_subset_mono
	+ list_all_replicate
	+
	+
	subsubsection\<open>Foundations\<close>

	abbreviation (input) if3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "if3 a b c \<equiv>
	(
	\<lambda>i. if i = 0 \<Rightarrow> a
	\| i = 1\<^sub>\<nat> \<Rightarrow> b
	\| otherwise \<Rightarrow> c
	)"
	lemma if3_0[V_cs_simps]: "if3 a b c 0 = a" by auto
	lemma if3_1[V_cs_simps]: "if3 a b c (1\<^sub>\<nat>) = b" by auto
	lemma if3_2[V_cs_simps]: "if3 a b c (2\<^sub>\<nat>) = c" by auto

	lemma vinsertI1':
	assumes "x' = x"
	shows "x \<in>\<^sub>\<circ> vinsert x' A"
	unfolding assms by (rule vinsertI1)

	lemma in_vsingleton[V_cs_intros]:
	assumes "f = a"
	shows "f \<in>\<^sub>\<circ> set {a}"
	unfolding assms by simp

	lemma a_in_succ_a: "a \<in>\<^sub>\<circ> succ a" by simp

	lemma a_in_succ_xI:
	assumes "a \<in>\<^sub>\<circ> x"
	shows "a \<in>\<^sub>\<circ> succ x"
	using assms by simp

	lemma vone_ne[V_cs_intros]: "1\<^sub>\<nat> \<noteq> 0" by clarsimp

	lemmas [V_cs_simps] =
	vinsert_set_insert_eq
	beta
	set_empty
	vcard_0

	lemmas [V_cs_intros] =
	mem_not_refl
	succ_notin_self
	vset_neq_1
	vset_neq_2
	nin_vinsertI
	vinsertI1'
	vinsertI2
	vfinite_vinsert
	vfinite_vsingleton
	vdisjnt_nin_right
	vdisjnt_nin_left
	vunionI1
	vunionI2
	vunion_in_VsetI
	vintersection_in_VsetI
	vsubset_reflexive
	vsingletonI
	small_insert small_empty
	Limit_vtimes_in_VsetI
	Limit_VPow_in_VsetI
	a_in_succ_a
	vsubset_vempty


	subsubsection\<open>Binary relations\<close>

	lemma vtimesI'[V_cs_intros]:
	assumes "ab = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
	shows "ab \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	using assms by simp

	lemma vrange_vcomp_vsubset[V_cs_intros]:
	assumes "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> B"
	shows "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vrange_vconst_on_vsubset[V_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> R"
	shows "\<R>\<^sub>\<circ> (vconst_on A a) \<subseteq>\<^sub>\<circ> R"
	using assms by auto

	lemma vrange_vcomp_eq_vrange[V_cs_simps]:
	assumes "\<D>\<^sub>\<circ> r = \<R>\<^sub>\<circ> s"
	shows "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) = \<R>\<^sub>\<circ> r"
	using assms by (metis vimage_vdomain vrange_vcomp)

	lemmas [V_cs_simps] =
	vdomain_vsingleton
	vdomain_vlrestriction
	+ vdomain_vlrestriction_vsubset
	vdomain_vcomp_vsubset
	vdomain_vconverse
	vrange_vconverse
	vdomain_vconst_on
	vconverse_vtimes
	vdomain_VLambda

	+lemmas [V_cs_intros] = vcpower_vsubset_mono
	+

	subsubsection\<open>Single-valued functions\<close>

	lemmas (in vsv) [V_cs_intros] = vsv_axioms

	lemma vpair_app:
	assumes "j = a"
	shows "set {\<langle>a, b\<rangle>}\<lparr>j\<rparr> = b"
	unfolding assms by simp

	lemmas [V_cs_simps] =
	vpair_app
	vsv.vlrestriction_app
	vsv_vcomp_at
	vid_on_atI

	lemmas (in vsv) [V_cs_intros] = vsv_vimageI2'

	lemmas [V_cs_intros] =
	vsv_vsingleton
	vsv.vsv_vimageI2'
	vsv_vcomp


	subsubsection\<open>Injective single-valued functions\<close>

	lemmas (in v11) [V_cs_intros] = v11_axioms

	lemma (in v11) v11_vconverse_app_in_vdomain':
	assumes "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" and "A = \<D>\<^sub>\<circ> r"
	shows "r\<inverse>\<^sub>\<circ>\<lparr>y\<rparr> \<in>\<^sub>\<circ> A"
	using assms(1) unfolding assms(2) by (rule v11_vconverse_app_in_vdomain)

	lemmas (in v11) [V_cs_intros] = v11_vconverse_app_in_vdomain'
	lemmas [V_cs_intros] = v11.v11_vconverse_app_in_vdomain'

	lemmas (in v11) [V_cs_simps] = (only in the context of v11)
	v11_app_if_vconverse_app[rotated -2]
	v11_app_vconverse_app
	v11_vconverse_app_app

	lemmas [V_cs_simps] =
	v11.v11_vconverse_app[rotated -1]
	v11.v11_app_vconverse_app
	v11.v11_vconverse_app_app

	lemmas [V_cs_intros] =
	v11D(1)
	v11.v11_vconverse
	v11_vcomp


	subsubsection\<open>Operations on indexed families of sets\<close>

	lemmas [V_cs_simps] =
	vprojection_app
	vprojection_vdomain

	lemmas [V_cs_intros] = vprojection_vsv


	subsubsection\<open>Finite sequences\<close>

	lemmas (in vfsequence) [V_cs_intros] = vfsequence_axioms

	lemmas (in vfsequence) [V_cs_simps] = vfsequence_vdomain
	lemmas [V_cs_simps] = vfsequence.vfsequence_vdomain

	lemmas [V_cs_intros] =
	vfsequence.vfsequence_vcons
	vfsequence_vempty

	lemmas [V_cs_simps] =
	vfinite_0_left
	vfinite_0_right


	subsubsection\<open>Binary relation as a finite sequence\<close>

	-lemmas [V_cs_simps] =
	+lemmas [V_cs_simps] =
	fconverse_vunion
	fconverse_ftimes
	vdomain_fflip

	+lemmas [V_cs_intros] =
	+ ftimesI2
	+ vcpower_two_ftimesI
	+

	subsubsection\<open>Ordinals\<close>

	lemmas [Ord_cs_intros] =
	Limit_right_Limit_mult
	Limit_left_Limit_mult
	Ord_succ_mono
	Limit_plus_omega_vsubset_Limit
	Limit_plus_nat_in_Limit


	subsubsection\<open>von Neumann hierarchy\<close>

	lemma (in \<Z>) omega_in_any[V_cs_intros]:
	assumes "\<alpha> \<subseteq>\<^sub>\<circ> \<beta>"
	shows "\<omega> \<in>\<^sub>\<circ> \<beta>"
	using assms by auto

	lemma Ord_vsubset_succ[V_cs_intros]:
	assumes "Ord \<alpha>" and "Ord \<beta>" and "\<alpha> \<subseteq>\<^sub>\<circ> \<beta>"
	shows "\<alpha> \<subseteq>\<^sub>\<circ> succ \<beta>"
	by (metis Ord_linear_le Ord_succ assms(1) assms(2) assms(3) leD succ_le_iff)

	lemma Ord_in_Vset_succ[V_cs_intros]:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	using assms by (auto simp: Ord_Vset_in_Vset_succI)

	lemma Ord_vsubset_Vset_succ[V_cs_intros]:
	assumes "Ord \<alpha>" and "B \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	shows "B \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
	by (intro vsubsetI)
	(auto simp: assms Vset_trans Ord_vsubset_in_Vset_succI)

	lemmas (in \<Z>) [V_cs_intros] =
	omega_in_\<alpha>
	Ord_\<alpha>
	Limit_\<alpha>

	lemmas [V_cs_intros] =
	vempty_in_Vset_succ
	\<Z>.ord_of_nat_in_Vset
	Vset_in_mono
	Limit_vpair_in_VsetI
	Vset_vsubset_mono
	Ord_succ
	Limit_vempty_in_VsetI
	Limit_insert_in_VsetI
	vfsequence.vfsequence_Limit_vcons_in_VsetI
	vfsequence.vfsequence_Ord_vcons_in_Vset_succI
	Limit_vdoubleton_in_VsetI
	Limit_omega_in_VsetI
	Limit_ftimes_in_VsetI


	subsubsection\<open>\<open>n\<close>-ary operations\<close>

	lemmas [V_cs_simps] =
	fflip_app
	vdomain_fflip


	subsubsection\<open>Countable ordinals as a set\<close>

	named_theorems omega_of_set
	named_theorems nat_omega_simps_extra

	lemmas [nat_omega_simps_extra] =
	add_num_simps
	Suc_numeral
	Suc_1
	le_num_simps
	less_numeral_simps(1,2)
	less_num_simps
	less_one
	nat_omega_simps

	lemmas [omega_of_set] = nat_omega_simps_extra

	lemma set_insert_succ[omega_of_set]:
	assumes [simp]: "small b" and "set b = a\<^sub>\<nat>"
	shows "set (insert (a\<^sub>\<nat>) b) = succ (a\<^sub>\<nat>)"
	unfolding assms(2)[symmetric] by auto

	lemma set_0[omega_of_set]: "set {0} = succ 0" by auto


	subsubsection\<open>Sequences\<close>

	named_theorems vfsequence_simps
	named_theorems vfsequence_intros

	lemmas [vfsequence_simps] =
	vfsequence.vfsequence_at_last[rotated]
	vfsequence.vfsequence_vcard_vcons[rotated]
	vfsequence.vfsequence_at_not_last[rotated]

	lemmas [vfsequence_intros] =
	vfsequence.vfsequence_vcons
	vfsequence_vempty


	subsubsection\<open>Further numerals\<close>

	named_theorems nat_omega_intros

	lemma [nat_omega_intros]:
	assumes "a < b"
	shows "a\<^sub>\<nat> \<in>\<^sub>\<circ> b\<^sub>\<nat>"
	using assms by simp

	lemma [nat_omega_intros]:
	assumes "0 < b"
	shows "0 \<in>\<^sub>\<circ> b\<^sub>\<nat>"
	using assms by auto

	lemma [nat_omega_intros]:
	assumes "a = numeral b"
	shows "(0::nat) < a"
	using assms by auto

	lemma nat_le_if_in[nat_omega_intros]:
	assumes "x\<^sub>\<nat> \<in>\<^sub>\<circ> y\<^sub>\<nat>"
	shows "x\<^sub>\<nat> \<le> y\<^sub>\<nat>"
	using assms by auto

	lemma vempty_le_nat[nat_omega_intros]: "0 \<le> y\<^sub>\<nat>" by auto

	lemmas [nat_omega_intros] =
	preorder_class.order_refl
	preorder_class.eq_refl


	subsubsection\<open>Generally available foundational results\<close>

	lemma (in \<Z>) \<Z>_\<beta>:
	assumes "\<beta> = \<alpha>"
	shows "\<Z> \<beta>"
	unfolding assms by auto

	lemmas (in \<Z>) [dg_cs_intros] = \<Z>_\<beta>

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Par.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Par.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Par.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Par.thy
	@@ -1,390 +1,397 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Par\<close> as a digraph\<close>
	theory CZH_DG_Par
	imports
	CZH_DG_Rel
	CZH_DG_Subdigraph
	begin



	subsection\<open>Background\<close>


	text\<open>
	\<open>Par\<close> is usually defined as a category of sets and partial functions
	(see nLab \cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/partial+function}
	}).
	However, there is little that can prevent one from exposing \<open>Par\<close>
	as a digraph and provide additional structure gradually in subsequent
	installments of this work. Thus, in this section, \<open>\<alpha>\<close>-\<open>Par\<close> is defined as a
	digraph of sets and partial functions in \<open>V\<^sub>\<alpha>\<close>
	\<close>

	named_theorems dg_Par_cs_simps
	named_theorems dg_Par_cs_intros

	lemmas [dg_Par_cs_simps] = dg_Rel_shared_cs_simps
	lemmas [dg_Par_cs_intros] = dg_Rel_shared_cs_intros



	subsection\<open>Arrow for \<open>Par\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale arr_Par = \<Z> \<alpha> + vfsequence T + ArrVal: vsv \<open>T\<lparr>ArrVal\<rparr>\<close> for \<alpha> T +
	assumes arr_Par_length[dg_Rel_shared_cs_simps, dg_Par_cs_simps]:
	"vcard T = 3\<^sub>\<nat>"
	and arr_Par_ArrVal_vdomain: "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>"
	and arr_Par_ArrVal_vrange: "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	and arr_Par_ArrDom_in_Vset: "T\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	and arr_Par_ArrCod_in_Vset: "T\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"


	text\<open>Elementary properties.\<close>

	sublocale arr_Par \<subseteq> arr_Rel
	by unfold_locales
	(
	simp_all add:
	dg_Par_cs_simps
	arr_Par_ArrVal_vdomain
	arr_Par_ArrVal_vrange
	arr_Par_ArrDom_in_Vset
	arr_Par_ArrCod_in_Vset
	)

	lemmas (in arr_Par) [dg_Par_cs_simps] = dg_Rel_shared_cs_simps


	text\<open>Rules.\<close>

	+lemma (in arr_Par) arr_Par_axioms'[dg_cs_intros, dg_Par_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ shows "arr_Par \<alpha>' T"
	+ unfolding assms by (rule arr_Par_axioms)
	+
	mk_ide rf arr_Par_def[unfolded arr_Par_axioms_def]
	\|intro arr_ParI\|
	\|dest arr_ParD[dest]\|
	\|elim arr_ParE[elim!]\|

	lemma (in \<Z>) arr_Par_vfsequenceI:
	assumes "vsv r"
	and "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> a"
	and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> b"
	and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Par \<alpha> [r, a, b]\<^sub>\<circ>"
	by (intro arr_ParI)
	(insert assms, auto simp: arr_Rel_components nat_omega_simps)

	lemma arr_Par_arr_RelI:
	assumes "arr_Rel \<alpha> T" and "vsv (T\<lparr>ArrVal\<rparr>)"
	shows "arr_Par \<alpha> T"
	proof-
	interpret arr_Rel \<alpha> T by (rule assms(1))
	show ?thesis
	by (intro arr_ParI)
	(
	auto simp:
	dg_Rel_cs_simps
	assms(2)
	vfsequence_axioms
	arr_Rel_ArrVal_vdomain
	arr_Rel_ArrVal_vrange
	arr_Rel_ArrDom_in_Vset
	arr_Rel_ArrCod_in_Vset
	)
	qed

	lemma arr_Par_arr_RelD:
	assumes "arr_Par \<alpha> T"
	shows "arr_Rel \<alpha> T" and "vsv (T\<lparr>ArrVal\<rparr>)"
	proof-
	interpret arr_Par \<alpha> T by (rule assms)
	show "arr_Rel \<alpha> T" and "vsv (T\<lparr>ArrVal\<rparr>)"
	by (rule arr_Rel_axioms) auto
	qed

	lemma arr_Par_arr_RelE:
	assumes "arr_Par \<alpha> T"
	obtains "arr_Rel \<alpha> T" and "vsv (T\<lparr>ArrVal\<rparr>)"
	using assms by (auto simp: arr_Par_arr_RelD)


	-text\<open>Further elementary properties.\<close>
	+text\<open>Further properties.\<close>

	lemma arr_Par_eqI:
	assumes "arr_Par \<alpha> S"
	and "arr_Par \<alpha> T"
	and "S\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr>"
	and "S\<lparr>ArrDom\<rparr> = T\<lparr>ArrDom\<rparr>"
	and "S\<lparr>ArrCod\<rparr> = T\<lparr>ArrCod\<rparr>"
	shows "S = T"
	proof(rule vsv_eqI)
	interpret S: arr_Par \<alpha> S by (rule assms(1))
	interpret T: arr_Par \<alpha> T by (rule assms(2))
	show "vsv S" by (rule S.vsv_axioms)
	show "vsv T" by (rule T.vsv_axioms)
	show "\<D>\<^sub>\<circ> S = \<D>\<^sub>\<circ> T"
	by (simp add: S.vfsequence_vdomain T.vfsequence_vdomain dg_Par_cs_simps)
	have dom: "\<D>\<^sub>\<circ> S = 3\<^sub>\<nat>" by (simp add: S.vfsequence_vdomain dg_Par_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> S \<Longrightarrow> S\<lparr>a\<rparr> = T\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms)
	(auto simp: arr_field_simps)
	qed

	lemma small_arr_Par[simp]: "small {T. arr_Par \<alpha> T}"
	proof(rule smaller_than_small)
	show "{T. arr_Par \<alpha> T} \<subseteq> {T. arr_Rel \<alpha> T}"
	by (simp add: Collect_mono arr_Par_arr_RelD(1))
	qed simp

	lemma set_Collect_arr_Par[simp]:
	"T \<in>\<^sub>\<circ> set (Collect (arr_Par \<alpha>)) \<longleftrightarrow> arr_Par \<alpha> T"
	by auto


	subsubsection\<open>Composition\<close>

	abbreviation (input) comp_Par :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>P\<^sub>a\<^sub>r\<close> 55)
	where "comp_Par \<equiv> comp_Rel"

	lemma arr_Par_comp_Par[dg_Par_cs_intros]:
	assumes "arr_Par \<alpha> S" and "arr_Par \<alpha> T"
	shows "arr_Par \<alpha> (S \<circ>\<^sub>P\<^sub>a\<^sub>r T)"
	proof(intro arr_Par_arr_RelI)
	interpret S: arr_Par \<alpha> S by (rule assms(1))
	interpret T: arr_Par \<alpha> T by (rule assms(2))
	show "arr_Rel \<alpha> (S \<circ>\<^sub>P\<^sub>a\<^sub>r T)"
	by (auto simp: S.arr_Rel_axioms T.arr_Rel_axioms arr_Rel_comp_Rel)
	show "vsv ((S \<circ>\<^sub>P\<^sub>a\<^sub>r T)\<lparr>ArrVal\<rparr>)"
	unfolding comp_Rel_components
	by (simp add: S.ArrVal.vsv_axioms T.ArrVal.vsv_axioms vsv_vcomp)
	qed

	+lemma arr_Par_comp_Par_ArrVal_app:
	+ assumes "arr_Par \<alpha> S"
	+ and "arr_Par \<alpha> T"
	+ and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+ and "T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	+ shows "(S \<circ>\<^sub>P\<^sub>a\<^sub>r T)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	+ using assms unfolding comp_Rel_components by (intro vcomp_atI) auto
	+

	subsubsection\<open>Inclusion\<close>

	abbreviation (input) incl_Par :: "V \<Rightarrow> V \<Rightarrow> V"
	where "incl_Par \<equiv> incl_Rel"

	lemma (in \<Z>) arr_Par_incl_ParI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "arr_Par \<alpha> (incl_Par A B)"
	proof(intro arr_Par_arr_RelI)
	from assms show "arr_Rel \<alpha> (incl_Par A B)"
	by (force intro: arr_Rel_incl_RelI)
	qed (simp add: incl_Rel_components)


	subsubsection\<open>Identity\<close>

	abbreviation (input) id_Par :: "V \<Rightarrow> V"
	where "id_Par \<equiv> id_Rel"

	lemma (in \<Z>) arr_Par_id_ParI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Par \<alpha> (id_Par A)"
	using assms
	by (intro arr_Par_arr_RelI)
	(auto intro: arr_Rel_id_RelI simp: id_Rel_components)

	lemma arr_Par_comp_Par_id_Par_left[dg_Par_cs_simps]:
	assumes "arr_Par \<alpha> f" and "f\<lparr>ArrCod\<rparr> = A"
	- shows "id_Par A \<circ>\<^sub>R\<^sub>e\<^sub>l f = f"
	+ shows "id_Par A \<circ>\<^sub>P\<^sub>a\<^sub>r f = f"
	proof-
	interpret f: arr_Par \<alpha> f by (rule assms(1))
	have "arr_Rel \<alpha> f" by (simp add: f.arr_Rel_axioms)
	from arr_Rel_comp_Rel_id_Rel_left[OF this assms(2)] show ?thesis .
	qed

	lemma arr_Par_comp_Par_id_Par_right[dg_Par_cs_simps]:
	assumes "arr_Par \<alpha> f" and "f\<lparr>ArrDom\<rparr> = A"
	- shows "f \<circ>\<^sub>R\<^sub>e\<^sub>l id_Par A = f"
	+ shows "f \<circ>\<^sub>P\<^sub>a\<^sub>r id_Par A = f"
	proof-
	interpret f: arr_Par \<alpha> f by (rule assms(1))
	have "arr_Rel \<alpha> f" by (simp add: f.arr_Rel_axioms)
	from arr_Rel_comp_Rel_id_Rel_right[OF this assms(2)] show ?thesis.
	qed

	-lemma arr_Par_comp_Par_ArrVal:
	- assumes "arr_Par \<alpha> S"
	- and "arr_Par \<alpha> T"
	- and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	- and "T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	- shows "(S \<circ>\<^sub>P\<^sub>a\<^sub>r T)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	- using assms
	- unfolding comp_Rel_components
	- by (intro vcomp_atI) auto
	-


	subsection\<open>\<open>Par\<close> as a digraph\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dg_Par :: "V \<Rightarrow> V"
	where "dg_Par \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Par \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_Par_components:
	shows "dg_Par \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "dg_Par \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Par \<alpha> T}"
	and "dg_Par \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "dg_Par \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	unfolding dg_Par_def dg_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object\<close>

	lemma dg_Par_Obj_iff: "x \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding dg_Par_components by auto


	subsubsection\<open>Arrow\<close>

	lemma dg_Par_Arr_iff[dg_Par_cs_simps]: "x \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Arr\<rparr> \<longleftrightarrow> arr_Par \<alpha> x"
	unfolding dg_Par_components by auto


	subsubsection\<open>Domain\<close>

	mk_VLambda dg_Par_components(3)
	\|vsv dg_Par_Dom_vsv[dg_Par_cs_intros]\|
	\|vdomain dg_Par_Dom_vdomain[dg_Par_cs_simps]\|
	\|app dg_Par_Dom_app[unfolded set_Collect_arr_Par, dg_Par_cs_simps]\|

	lemma dg_Par_Dom_vrange: "\<R>\<^sub>\<circ> (dg_Par \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Par_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Par) auto


	subsubsection\<open>Codomain\<close>

	mk_VLambda dg_Par_components(4)
	\|vsv dg_Par_Cod_vsv[dg_Par_cs_intros]\|
	\|vdomain dg_Par_Cod_vdomain[dg_Par_cs_simps]\|
	\|app dg_Par_Cod_app[unfolded set_Collect_arr_Par, dg_Par_cs_simps]\|

	lemma dg_Par_Cod_vrange: "\<R>\<^sub>\<circ> (dg_Par \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Par_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Par) auto


	subsubsection\<open>Arrow with a domain and a codomain\<close>


	text\<open>Rules.\<close>

	lemma dg_Par_is_arrI:
	assumes "arr_Par \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	shows "S : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	using assms by (intro is_arrI, unfold dg_Par_components) simp_all

	lemmas [dg_Par_cs_intros] = dg_Par_is_arrI

	lemma dg_Par_is_arrD:
	assumes "S : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	shows "arr_Par \<alpha> S"
	and [dg_cs_simps]: "S\<lparr>ArrDom\<rparr> = A"
	and [dg_cs_simps]: "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Par_components by simp_all

	lemma dg_Par_is_arrE:
	assumes "S : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	obtains "arr_Par \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Par_components by simp_all


	text\<open>Elementary properties.\<close>

	lemma dg_Par_is_arr_dg_Rel_is_arr:
	assumes "r : a \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> b"
	shows "r : a \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> b"
	using assms arr_Par_arr_RelD(1)
	by (intro dg_Rel_is_arrI; elim dg_Par_is_arrE) auto

	lemma dg_Par_Hom_vsubset_dg_Rel_Hom:
	assumes "a \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "Hom (dg_Par \<alpha>) a b \<subseteq>\<^sub>\<circ> Hom (dg_Rel \<alpha>) a b"
	by (rule vsubsetI) (simp add: dg_Par_is_arr_dg_Rel_is_arr)

	lemma (in \<Z>) dg_Par_incl_Par_is_arr:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	+ assumes "A \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "incl_Par A B : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	by (rule dg_Par_is_arrI)
	- (auto simp: incl_Rel_components intro!: arr_Par_incl_ParI assms)
	+ (
	+ auto
	+ simp: incl_Rel_components
	+ intro!: arr_Par_incl_ParI assms[unfolded dg_Par_components(1)]
	+ )

	lemma (in \<Z>) dg_Par_incl_Par_is_arr'[dg_Par_cs_intros]:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	+ assumes "A \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	+ and "B \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	and "A \<subseteq>\<^sub>\<circ> B"
	and "A' = A"
	and "B' = B"
	shows "incl_Par A B : A' \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B'"
	using assms(1-3) unfolding assms(4,5) by (rule dg_Par_incl_Par_is_arr)

	lemmas [dg_Par_cs_intros] = \<Z>.dg_Par_incl_Par_is_arr'


	subsubsection\<open>\<open>Par\<close> is a digraph\<close>

	lemma (in \<Z>) dg_Par_Hom_vifunion_in_Vset:
	assumes "X \<in>\<^sub>\<circ> Vset \<alpha>" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Par \<alpha>) A B) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have
	"(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Par \<alpha>) A B) \<subseteq>\<^sub>\<circ>
	(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B)"
	proof(intro vsubsetI)
	fix F assume "F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Par \<alpha>) A B)"
	then obtain B where B: "B \<in>\<^sub>\<circ> Y" and "F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. Hom (dg_Par \<alpha>) A B)"
	by fast
	then obtain A where A: "A \<in>\<^sub>\<circ> X" and F_AB: "F \<in>\<^sub>\<circ> Hom (dg_Par \<alpha>) A B" by fast
	from A B assms have "A \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" "B \<in>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Par_components by auto
	from F_AB A B dg_Par_Hom_vsubset_dg_Rel_Hom[OF this] show
	"F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B)"
	by (intro vifunionI) (auto elim!: vsubsetE simp: in_Hom_iff)
	qed
	with dg_Rel_Hom_vifunion_in_Vset[OF assms] show ?thesis by blast
	qed

	lemma (in \<Z>) digraph_dg_Par: "digraph \<alpha> (dg_Par \<alpha>)"
	proof(intro digraphI)
	show "vfsequence (dg_Par \<alpha>)" unfolding dg_Par_def by simp
	show "vcard (dg_Par \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Par_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_Par \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Par_Dom_vrange)
	show "\<R>\<^sub>\<circ> (dg_Par \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Par \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Par_Cod_vrange)
	qed (auto simp: dg_Par_components dg_Par_Hom_vifunion_in_Vset)


	subsubsection\<open>\<open>Par\<close> is a wide subdigraph of \<open>Rel\<close>\<close>

	lemma (in \<Z>) wide_subdigraph_dg_Par_dg_Rel: "dg_Par \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	proof(intro wide_subdigraphI)
	show "dg_Par \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	by (intro subdigraphI, unfold dg_Par_components)
	(
	auto simp:
	dg_Rel_components
	digraph_dg_Par
	digraph_dg_Rel
	dg_Par_is_arr_dg_Rel_is_arr
	)
	qed (simp_all add: dg_Rel_components dg_Par_components)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Rel.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Rel.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Rel.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Rel.thy
	@@ -1,946 +1,947 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Rel\<close> as a digraph\<close>
	theory CZH_DG_Rel
	imports CZH_DG_Small_DGHM
	begin



	subsection\<open>Background\<close>


	text\<open>
	\<open>Rel\<close> is usually defined as a category of sets and binary relations
	(e.g., see Chapter I-7 in \cite{mac_lane_categories_2010}). However, there
	is little that can prevent one from exposing \<open>Rel\<close> as a digraph and
	-provide additional structure gradually in subsequent installments of this
	-work. Thus, in this section, \<open>\<alpha>\<close>-\<open>Rel\<close> is defined as a digraph of sets
	+provide additional structure gradually later.
	+Thus, in this section, \<open>\<alpha>\<close>-\<open>Rel\<close> is defined as a digraph of sets
	and binary relations in \<open>V\<^sub>\<alpha>\<close>.
	\<close>

	named_theorems dg_Rel_shared_cs_simps
	named_theorems dg_Rel_shared_cs_intros

	named_theorems dg_Rel_cs_simps
	named_theorems dg_Rel_cs_intros



	subsection\<open>Canonical arrow for \<^typ>\<open>V\<close>\<close>

	named_theorems arr_field_simps

	definition ArrVal :: V where [arr_field_simps]: "ArrVal = 0"
	definition ArrDom :: V where [arr_field_simps]: "ArrDom = 1\<^sub>\<nat>"
	definition ArrCod :: V where [arr_field_simps]: "ArrCod = 2\<^sub>\<nat>"

	lemma ArrVal_eq_helper:
	assumes "f = g"
	shows "f\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = g\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	using assms by simp



	subsection\<open>Arrow for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale arr_Rel = \<Z> \<alpha> + vfsequence T + ArrVal: vbrelation \<open>T\<lparr>ArrVal\<rparr>\<close> for \<alpha> T +
	assumes arr_Rel_length[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"vcard T = 3\<^sub>\<nat>"
	and arr_Rel_ArrVal_vdomain: "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>"
	and arr_Rel_ArrVal_vrange: "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	and arr_Rel_ArrDom_in_Vset: "T\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	and arr_Rel_ArrCod_in_Vset: "T\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"

	-lemmas [dg_Rel_cs_simps] = arr_Rel.arr_Rel_length
	+lemmas [dg_Rel_shared_cs_simps, dg_Rel_cs_simps] = arr_Rel.arr_Rel_length


	text\<open>Components.\<close>

	lemma arr_Rel_components[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	shows "[f, A, B]\<^sub>\<circ>\<lparr>ArrVal\<rparr> = f"
	and "[f, A, B]\<^sub>\<circ>\<lparr>ArrDom\<rparr> = A"
	and "[f, A, B]\<^sub>\<circ>\<lparr>ArrCod\<rparr> = B"
	unfolding arr_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Rules.\<close>

	+lemma (in arr_Rel) arr_Rel_axioms'[dg_cs_intros, dg_Rel_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ shows "arr_Rel \<alpha>' T"
	+ unfolding assms by (rule arr_Rel_axioms)
	+
	mk_ide rf arr_Rel_def[unfolded arr_Rel_axioms_def]
	\|intro arr_RelI\|
	\|dest arr_RelD[dest]\|
	\|elim arr_RelE[elim!]\|

	lemma (in \<Z>) arr_Rel_vfsequenceI:
	assumes "vbrelation r"
	and "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> a"
	and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> b"
	and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Rel \<alpha> [r, a, b]\<^sub>\<circ>"
	by (intro arr_RelI)
	(insert assms, auto simp: nat_omega_simps arr_Rel_components)


	text\<open>Elementary properties.\<close>

	lemma arr_Rel_eqI:
	assumes "arr_Rel \<alpha> S"
	and "arr_Rel \<alpha> T"
	and "S\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr>"
	and "S\<lparr>ArrDom\<rparr> = T\<lparr>ArrDom\<rparr>"
	and "S\<lparr>ArrCod\<rparr> = T\<lparr>ArrCod\<rparr>"
	shows "S = T"
	proof-
	interpret S: arr_Rel \<alpha> S by (rule assms(1))
	interpret T: arr_Rel \<alpha> T by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	show "\<D>\<^sub>\<circ> S = \<D>\<^sub>\<circ> T"
	by (simp add: S.vfsequence_vdomain T.vfsequence_vdomain dg_Rel_cs_simps)
	have dom_lhs: "\<D>\<^sub>\<circ> S = 3\<^sub>\<nat>"
	by (simp add: S.vfsequence_vdomain dg_Rel_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> S \<Longrightarrow> S\<lparr>a\<rparr> = T\<lparr>a\<rparr>" for a
	by (unfold dom_lhs, elim_in_numeral, insert assms)
	(auto simp: arr_field_simps)
	qed auto
	qed

	lemma (in arr_Rel) arr_Rel_def: "T = [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> T = 3\<^sub>\<nat>" by (simp add: vfsequence_vdomain dg_Rel_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ> = 3\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> T = \<D>\<^sub>\<circ> [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> T \<Longrightarrow> T\<lparr>a\<rparr> = [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" for a
	unfolding dom_lhs
	by elim_in_numeral (simp_all add: arr_field_simps nat_omega_simps)
	qed (auto simp: vsv_axioms)


	text\<open>Size.\<close>

	lemma (in arr_Rel) arr_Rel_ArrVal_in_Vset: "T\<lparr>ArrVal\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from arr_Rel_ArrVal_vdomain arr_Rel_ArrDom_in_Vset have
	"\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	moreover from arr_Rel_ArrVal_vrange arr_Rel_ArrCod_in_Vset have
	"\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	ultimately show "T\<lparr>ArrVal\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: ArrVal.vbrelation_Limit_in_VsetI)
	qed

	lemma (in arr_Rel) arr_Rel_in_Vset: "T \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	note [dg_Rel_cs_intros] =
	arr_Rel_ArrVal_in_Vset arr_Rel_ArrDom_in_Vset arr_Rel_ArrCod_in_Vset
	show ?thesis
	by (subst arr_Rel_def)
	(cs_concl cs_shallow cs_intro: dg_Rel_cs_intros V_cs_intros)
	qed

	lemma small_arr_Rel[simp]: "small {T. arr_Rel \<alpha> T}"
	by (rule down[of _ \<open>Vset \<alpha>\<close>]) (auto intro!: arr_Rel.arr_Rel_in_Vset)


	text\<open>Other elementary properties.\<close>

	lemma set_Collect_arr_Rel[simp]:
	"x \<in>\<^sub>\<circ> set (Collect (arr_Rel \<alpha>)) \<longleftrightarrow> arr_Rel \<alpha> x"
	by auto

	lemma (in arr_Rel) arr_Rel_ArrVal_vsubset_ArrDom_ArrCod:
	"T\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> T\<lparr>ArrDom\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	proof
	fix ab assume "ab \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	then obtain a b where "ab = \<langle>a, b\<rangle>"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	by (blast elim: ArrVal.vbrelation_vinE)
	with arr_Rel_ArrVal_vdomain arr_Rel_ArrVal_vrange show
	"ab \<in>\<^sub>\<circ> T\<lparr>ArrDom\<rparr> \<times>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	by auto
	qed


	subsubsection\<open>Composition\<close>


	text\<open>See Chapter I-7 in \cite{mac_lane_categories_2010}.\<close>

	definition comp_Rel :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>R\<^sub>e\<^sub>l\<close> 55)
	where "comp_Rel S T = [S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, S\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma comp_Rel_components:
	shows "(S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr> = S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"(S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr> = T\<lparr>ArrDom\<rparr>"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"(S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrCod\<rparr> = S\<lparr>ArrCod\<rparr>"
	unfolding comp_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Elementary properties.\<close>

	lemma comp_Rel_vsv[dg_Rel_shared_cs_intros, dg_Rel_cs_intros]:
	"vsv (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)"
	unfolding comp_Rel_def by auto

	lemma arr_Rel_comp_Rel[dg_Rel_cs_intros]:
	assumes "arr_Rel \<alpha> S" and "arr_Rel \<alpha> T"
	shows "arr_Rel \<alpha> (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)"
	proof-
	interpret S: arr_Rel \<alpha> S by (rule assms(1))
	interpret T: arr_Rel \<alpha> T by (rule assms(2))
	show ?thesis
	proof(intro arr_RelI)
	show "vfsequence (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)" unfolding comp_Rel_def by simp
	show "vcard (S \<circ>\<^sub>R\<^sub>e\<^sub>l T) = 3\<^sub>\<nat>"
	unfolding comp_Rel_def by (simp add: nat_omega_simps)
	from T.arr_Rel_ArrVal_vdomain show
	"\<D>\<^sub>\<circ> ((S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr>"
	unfolding comp_Rel_components by auto
	show "\<R>\<^sub>\<circ> ((S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrCod\<rparr>"
	unfolding comp_Rel_components
	proof(intro vsubsetI)
	fix z assume "z \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>)"
	then obtain x y where "\<langle>y, z\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" and "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	by (meson vcomp_obtain_middle vrange_iff_vdomain)
	with S.arr_Rel_ArrVal_vrange show "z \<in>\<^sub>\<circ> S\<lparr>ArrCod\<rparr>" by auto
	qed
	qed
	(
	auto simp:
	comp_Rel_components T.arr_Rel_ArrDom_in_Vset S.arr_Rel_ArrCod_in_Vset
	)
	qed

	lemma arr_Rel_comp_Rel_assoc[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"(H \<circ>\<^sub>R\<^sub>e\<^sub>l G) \<circ>\<^sub>R\<^sub>e\<^sub>l F = H \<circ>\<^sub>R\<^sub>e\<^sub>l (G \<circ>\<^sub>R\<^sub>e\<^sub>l F)"
	by (simp add: comp_Rel_def vcomp_assoc arr_field_simps nat_omega_simps)


	subsubsection\<open>Inclusion arrow\<close>


	text\<open>
	The definition of the inclusion arrow is based on the concept of the
	inclusion map, e.g., see \cite{noauthor_wikipedia_2001}\footnote{
	\url{https://en.wikipedia.org/wiki/Inclusion_map}
	}\<close>

	definition "incl_Rel A B = [vid_on A, A, B]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma incl_Rel_components:
	shows "incl_Rel A B\<lparr>ArrVal\<rparr> = vid_on A"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "incl_Rel A B\<lparr>ArrDom\<rparr> = A"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "incl_Rel A B\<lparr>ArrCod\<rparr> = B"
	unfolding incl_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Arrow value.\<close>

	lemma incl_Rel_ArrVal_vsv[dg_Rel_shared_cs_intros, dg_Rel_cs_intros]:
	"vsv (incl_Rel A B\<lparr>ArrVal\<rparr>)"
	unfolding incl_Rel_components by simp

	lemma incl_Rel_ArrVal_vdomain[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"\<D>\<^sub>\<circ> (incl_Rel A B\<lparr>ArrVal\<rparr>) = A"
	unfolding incl_Rel_components by simp

	lemma incl_Rel_ArrVal_app[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "incl_Rel A B\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = a"
	using assms unfolding incl_Rel_components by simp


	text\<open>Elementary properties.\<close>

	lemma incl_Rel_vfsequence[dg_Rel_shared_cs_intros, dg_Rel_cs_intros]:
	"vfsequence (incl_Rel A B)"
	unfolding incl_Rel_def by simp

	lemma incl_Rel_vcard[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"vcard (incl_Rel A B) = 3\<^sub>\<nat>"
	unfolding incl_Rel_def incl_Rel_def by (simp add: nat_omega_simps)

	lemma (in \<Z>) arr_Rel_incl_RelI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "arr_Rel \<alpha> (incl_Rel A B)"
	proof(intro arr_RelI)
	show "vfsequence (incl_Rel A B)" unfolding incl_Rel_def by simp
	show "vcard (incl_Rel A B) = 3\<^sub>\<nat>"
	unfolding incl_Rel_def by (simp add: nat_omega_simps)
	qed (auto simp: incl_Rel_components assms)


	subsubsection\<open>Identity\<close>


	text\<open>See Chapter I-7 in \cite{mac_lane_categories_2010}.\<close>

	definition id_Rel :: "V \<Rightarrow> V"
	where "id_Rel A = incl_Rel A A"


	text\<open>Components.\<close>

	lemma id_Rel_components:
	shows "id_Rel A\<lparr>ArrVal\<rparr> = vid_on A"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "id_Rel A\<lparr>ArrDom\<rparr> = A"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "id_Rel A\<lparr>ArrCod\<rparr> = A"
	unfolding id_Rel_def incl_Rel_components by simp_all


	text\<open>Elementary properties.\<close>

	lemma id_Rel_vfsequence[dg_Rel_shared_cs_intros, dg_Rel_cs_intros]:
	"vfsequence (id_Rel A)"
	unfolding id_Rel_def by (simp add: dg_Rel_cs_intros)

	lemma id_Rel_vcard[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"vcard (id_Rel A) = 3\<^sub>\<nat>"
	unfolding id_Rel_def by (simp add: dg_Rel_cs_simps)

	lemma (in \<Z>) arr_Rel_id_RelI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Rel \<alpha> (id_Rel A)"
	by (intro arr_RelI)
	(auto simp: id_Rel_components(1) assms dg_Rel_cs_intros dg_Rel_cs_simps)

	lemma id_Rel_ArrVal_app[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "id_Rel A\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = a"
	using assms unfolding id_Rel_components by simp

	lemma arr_Rel_comp_Rel_id_Rel_left[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> F" and "F\<lparr>ArrCod\<rparr> = A"
	shows "id_Rel A \<circ>\<^sub>R\<^sub>e\<^sub>l F = F"
	proof(rule arr_Rel_eqI [of \<alpha>])
	interpret F: arr_Rel \<alpha> F by (rule assms(1))
	from assms(2) have "A \<in>\<^sub>\<circ> Vset \<alpha>" by (auto intro: F.arr_Rel_ArrCod_in_Vset)
	with assms(1) show "arr_Rel \<alpha> (id_Rel A \<circ>\<^sub>R\<^sub>e\<^sub>l F)"
	by (blast intro: F.arr_Rel_id_RelI intro!: arr_Rel_comp_Rel)
	from assms(2) F.arr_Rel_ArrVal_vrange show
	"(id_Rel A \<circ>\<^sub>R\<^sub>e\<^sub>l F)\<lparr>ArrVal\<rparr> = F\<lparr>ArrVal\<rparr>"
	unfolding comp_Rel_components id_Rel_components by auto
	qed
	(
	use assms(2) in
	\<open>auto simp: assms(1) comp_Rel_components id_Rel_components\<close>
	)

	lemma arr_Rel_comp_Rel_id_Rel_right[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> F" and "F\<lparr>ArrDom\<rparr> = A"
	shows "F \<circ>\<^sub>R\<^sub>e\<^sub>l id_Rel A = F"
	proof(rule arr_Rel_eqI[of \<alpha>])
	interpret F: arr_Rel \<alpha> F by (rule assms(1))
	from assms(2) have "A \<in>\<^sub>\<circ> Vset \<alpha>" by (auto intro: F.arr_Rel_ArrDom_in_Vset)
	with assms(1) show "arr_Rel \<alpha> (F \<circ>\<^sub>R\<^sub>e\<^sub>l id_Rel A)"
	by (blast intro: F.arr_Rel_id_RelI intro!: arr_Rel_comp_Rel)
	show "arr_Rel \<alpha> F" by (simp add: assms(1))
	from assms(2) F.arr_Rel_ArrVal_vdomain show
	"(F \<circ>\<^sub>R\<^sub>e\<^sub>l id_Rel A)\<lparr>ArrVal\<rparr> = F\<lparr>ArrVal\<rparr>"
	unfolding comp_Rel_components id_Rel_components by auto
	qed (use assms(2) in \<open>auto simp: comp_Rel_components id_Rel_components\<close>)


	subsubsection\<open>Converse\<close>


	text\<open>
	As mentioned in Chapter I-7 in \cite{mac_lane_categories_2010}, the
	category \<open>Rel\<close> is usually equipped with an additional structure that is
	the operation of taking a converse of a relation.
	The operation is meant to be used almost exclusively as part of
	the dagger functor for \<open>Rel\<close>.
	\<close>

	definition converse_Rel :: "V \<Rightarrow> V" ("(_\<inverse>\<^sub>R\<^sub>e\<^sub>l)" [1000] 999)
	where "converse_Rel T = [(T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>, T\<lparr>ArrCod\<rparr>, T\<lparr>ArrDom\<rparr>]\<^sub>\<circ>"

	lemma converse_Rel_components:
	shows "T\<inverse>\<^sub>R\<^sub>e\<^sub>l\<lparr>ArrVal\<rparr> = (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "T\<inverse>\<^sub>R\<^sub>e\<^sub>l\<lparr>ArrDom\<rparr> = T\<lparr>ArrCod\<rparr>"
	and [dg_Rel_shared_cs_simps, dg_Rel_cs_simps]: "T\<inverse>\<^sub>R\<^sub>e\<^sub>l\<lparr>ArrCod\<rparr> = T\<lparr>ArrDom\<rparr>"
	unfolding converse_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Elementary properties.\<close>

	lemma (in arr_Rel) arr_Rel_converse_Rel: "arr_Rel \<alpha> (T\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	proof(rule arr_RelI, unfold converse_Rel_components)
	show "vfsequence (T\<inverse>\<^sub>R\<^sub>e\<^sub>l)" unfolding converse_Rel_def by simp
	show "vcard (T\<inverse>\<^sub>R\<^sub>e\<^sub>l) = 3\<^sub>\<nat>"
	unfolding converse_Rel_def by (simp add: nat_omega_simps)
	qed
	(
	auto simp:
	converse_Rel_components(1)
	arr_Rel_ArrDom_in_Vset
	arr_Rel_ArrCod_in_Vset
	arr_Rel_ArrVal_vdomain
	arr_Rel_ArrVal_vrange
	)

	lemmas [dg_Rel_cs_intros] =
	arr_Rel.arr_Rel_converse_Rel

	lemma (in arr_Rel)
	arr_Rel_converse_Rel_converse_Rel[dg_Rel_shared_cs_simps, dg_Rel_cs_simps]:
	"(T\<inverse>\<^sub>R\<^sub>e\<^sub>l)\<inverse>\<^sub>R\<^sub>e\<^sub>l = T"
	proof(rule arr_Rel_eqI)
	from arr_Rel_axioms show "arr_Rel \<alpha> ((T\<inverse>\<^sub>R\<^sub>e\<^sub>l)\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	by (cs_intro_step dg_Rel_cs_intros)+
	qed (simp_all add: arr_Rel_axioms converse_Rel_components)

	lemmas [dg_Rel_cs_simps] =
	arr_Rel.arr_Rel_converse_Rel_converse_Rel

	lemma arr_Rel_converse_Rel_eq_iff[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> F" and "arr_Rel \<alpha> G"
	shows "F\<inverse>\<^sub>R\<^sub>e\<^sub>l = G\<inverse>\<^sub>R\<^sub>e\<^sub>l \<longleftrightarrow> F = G"
	proof(rule iffI)
	show "F\<inverse>\<^sub>R\<^sub>e\<^sub>l = G\<inverse>\<^sub>R\<^sub>e\<^sub>l \<Longrightarrow> F = G"
	by (metis arr_Rel.arr_Rel_converse_Rel_converse_Rel assms)
	qed simp

	lemma arr_Rel_converse_Rel_comp_Rel[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> G" and "arr_Rel \<alpha> F"
	shows "(F \<circ>\<^sub>R\<^sub>e\<^sub>l G)\<inverse>\<^sub>R\<^sub>e\<^sub>l = G\<inverse>\<^sub>R\<^sub>e\<^sub>l \<circ>\<^sub>R\<^sub>e\<^sub>l F\<inverse>\<^sub>R\<^sub>e\<^sub>l"
	proof(rule arr_Rel_eqI, unfold converse_Rel_components comp_Rel_components)
	from assms show "arr_Rel \<alpha> (G\<inverse>\<^sub>R\<^sub>e\<^sub>l \<circ>\<^sub>R\<^sub>e\<^sub>l F\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	by (cs_concl cs_shallow cs_intro: dg_Rel_cs_intros)
	from assms show "arr_Rel \<alpha> ((F \<circ>\<^sub>R\<^sub>e\<^sub>l G)\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	by (cs_intro_step dg_Rel_cs_intros)+
	qed (simp_all add: vconverse_vcomp)

	lemma (in \<Z>) arr_Rel_converse_Rel_id_Rel:
	assumes "c \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Rel \<alpha> ((id_Rel c)\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	using assms \<Z>_axioms
	by (cs_concl cs_shallow cs_intro: dg_Rel_cs_intros arr_Rel_id_RelI)+

	lemma (in \<Z>) arr_Rel_converse_Rel_id_Rel_eq_id_Rel[
	dg_Rel_shared_cs_simps, dg_Rel_cs_simps
	]:
	assumes "c \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(id_Rel c)\<inverse>\<^sub>R\<^sub>e\<^sub>l = id_Rel c"
	by (rule arr_Rel_eqI[of \<alpha>], unfold converse_Rel_components id_Rel_components)
	(simp_all add: assms arr_Rel_id_RelI arr_Rel_converse_Rel_id_Rel)

	lemmas [dg_Rel_shared_cs_simps, dg_Rel_cs_simps] =
	\<Z>.arr_Rel_converse_Rel_id_Rel_eq_id_Rel

	lemma arr_Rel_comp_Rel_converse_Rel_left_if_v11[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> T"
	and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "T\<lparr>ArrDom\<rparr> = A"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "T\<inverse>\<^sub>R\<^sub>e\<^sub>l \<circ>\<^sub>R\<^sub>e\<^sub>l T = id_Rel A"
	proof-
	interpret T: arr_Rel \<alpha> T by (rule assms(1))
	interpret v11: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule assms(4))
	show ?thesis
	by (rule arr_Rel_eqI[of \<alpha>])
	(
	auto simp:
	converse_Rel_components
	comp_Rel_components
	id_Rel_components
	assms(1,3,5)
	arr_Rel.arr_Rel_converse_Rel
	arr_Rel_comp_Rel
	T.arr_Rel_id_RelI
	v11.v11_vcomp_vconverse[unfolded assms(2)]
	)
	qed

	lemma arr_Rel_comp_Rel_converse_Rel_right_if_v11[dg_Rel_cs_simps]:
	assumes "arr_Rel \<alpha> T"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	and "T\<lparr>ArrCod\<rparr> = A"
	and "v11 (T\<lparr>ArrVal\<rparr>)"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "T \<circ>\<^sub>R\<^sub>e\<^sub>l T\<inverse>\<^sub>R\<^sub>e\<^sub>l = id_Rel A"
	proof-
	interpret T: arr_Rel \<alpha> T by (rule assms(1))
	interpret v11: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule assms(4))
	show ?thesis
	by (rule arr_Rel_eqI[of \<alpha>])
	(
	auto simp:
	assms(1,3,5)
	comp_Rel_components
	converse_Rel_components
	id_Rel_components
	v11.v11_vcomp_vconverse'[unfolded assms(2)]
	T.arr_Rel_id_RelI
	arr_Rel.arr_Rel_converse_Rel
	arr_Rel_comp_Rel
	)
	qed



	subsection\<open>\<open>Rel\<close> as a digraph\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dg_Rel :: "V \<Rightarrow> V"
	where "dg_Rel \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Rel \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_Rel_components:
	shows "dg_Rel \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "dg_Rel \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Rel \<alpha> T}"
	and "dg_Rel \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "dg_Rel \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	unfolding dg_Rel_def dg_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object\<close>

	lemma dg_Rel_Obj_iff: "x \<in>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding dg_Rel_components by auto


	subsubsection\<open>Arrow\<close>

	lemma dg_Rel_Arr_iff[dg_Rel_cs_simps]: "x \<in>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Arr\<rparr> \<longleftrightarrow> arr_Rel \<alpha> x"
	unfolding dg_Rel_components by auto


	subsubsection\<open>Domain\<close>

	mk_VLambda dg_Rel_components(3)
	\|vsv dg_Rel_Dom_vsv[dg_Rel_cs_intros]\|
	\|vdomain dg_Rel_Dom_vdomain[dg_Rel_cs_simps]\|
	\|app dg_Rel_Dom_app[unfolded set_Collect_arr_Rel, dg_Rel_cs_simps]\|

	lemma dg_Rel_Dom_vrange: "\<R>\<^sub>\<circ> (dg_Rel \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Rel_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Rel) auto


	subsubsection\<open>Codomain\<close>

	mk_VLambda dg_Rel_components(4)
	\|vsv dg_Rel_Cod_vsv[dg_Rel_cs_intros]\|
	\|vdomain dg_Rel_Cod_vdomain[dg_Rel_cs_simps]\|
	\|app dg_Rel_Cod_app[unfolded set_Collect_arr_Rel, dg_Rel_cs_simps]\|

	lemma dg_Rel_Cod_vrange: "\<R>\<^sub>\<circ> (dg_Rel \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Rel_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Rel) auto


	subsubsection\<open>Arrow with a domain and a codomain\<close>


	text\<open>Rules.\<close>

	lemma dg_Rel_is_arrI[dg_Rel_cs_intros]:
	assumes "arr_Rel \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	shows "S : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	using assms by (intro is_arrI, unfold dg_Rel_components) simp_all

	lemma dg_Rel_is_arrD:
	assumes "S : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	shows "arr_Rel \<alpha> S"
	and [dg_cs_simps]: "S\<lparr>ArrDom\<rparr> = A"
	and [dg_cs_simps]: "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Rel_components by simp_all

	lemma dg_Rel_is_arrE:
	assumes "S : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	obtains "arr_Rel \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Rel_components by simp_all


	text\<open>Elementary properties.\<close>

	lemma (in \<Z>) dg_Rel_incl_Rel_is_arr:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "incl_Rel A B : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	proof(rule dg_Rel_is_arrI)
	show "arr_Rel \<alpha> (incl_Rel A B)" by (intro arr_Rel_incl_RelI assms)
	qed (simp_all add: incl_Rel_components)

	lemma (in \<Z>) dg_Rel_incl_Rel_is_arr'[dg_Rel_cs_intros]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	and "A \<subseteq>\<^sub>\<circ> B"
	and "A' = A"
	and "B' = B"
	shows "incl_Rel A B : A' \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B'"
	using assms(1-3) unfolding assms(4,5) by (rule dg_Rel_incl_Rel_is_arr)

	lemmas [dg_Rel_cs_intros] = \<Z>.dg_Rel_incl_Rel_is_arr'

	lemma dg_Rel_is_arr_ArrValE:
	assumes "T : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B" and "ab \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	obtains a b
	where "ab = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof-
	note T = dg_Rel_is_arrD[OF assms(1)]
	then interpret T: arr_Rel \<alpha> T
	rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	by simp_all
	from assms(2) obtain a b
	where "ab = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	by (blast elim: T.ArrVal.vbrelation_vinE)
	with that show ?thesis by simp
	qed


	subsubsection\<open>\<open>Rel\<close> is a digraph\<close>

	lemma (in \<Z>) dg_Rel_Hom_vifunion_in_Vset:
	assumes "X \<in>\<^sub>\<circ> Vset \<alpha>" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	define Q where
	"Q i = (if i = 0 then VPow (\<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y) else if i = 1\<^sub>\<nat> then X else Y)"
	for i
	have
	"{[r, A, B]\<^sub>\<circ> \|r A B. r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y \<and> A \<in>\<^sub>\<circ> X \<and> B \<in>\<^sub>\<circ> Y} \<subseteq>
	elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
	fix F r A B assume prems:
	"F = [r, A, B]\<^sub>\<circ>"
	"r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y"
	"A \<in>\<^sub>\<circ> X"
	"B \<in>\<^sub>\<circ> Y"
	show "F \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	show "\<D>\<^sub>\<circ> F = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	by (simp add: three prems(1) nat_omega_simps)
	fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	then consider \<open>i = 0\<close> \| \<open>i = 1\<^sub>\<nat>\<close> \| \<open>i = 2\<^sub>\<nat>\<close> by auto
	then show "F\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i" by cases (auto simp: Q_def prems nat_omega_simps)
	qed (auto simp: prems(1))
	qed
	moreover then have small[simp]:
	"small {[r, A, B]\<^sub>\<circ> \| r A B. r \<subseteq>\<^sub>\<circ>\<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y \<and> A \<in>\<^sub>\<circ> X \<and> B \<in>\<^sub>\<circ> Y}"
	by (rule down)
	ultimately have
	"set {[r, A, B]\<^sub>\<circ> \|r A B. r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y \<and> A \<in>\<^sub>\<circ> X \<and> B \<in>\<^sub>\<circ> Y} \<subseteq>\<^sub>\<circ>
	(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	by auto
	moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule Limit_vproduct_in_VsetI)
	show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: three[symmetric] intro!: Axiom_of_Infinity)
	from assms(1,2) have "VPow (\<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (intro Limit_VPow_in_VsetI Limit_vtimes_in_VsetI) auto
	then show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	using that assms(1,2) unfolding Q_def by (auto simp: nat_omega_simps)
	qed auto
	moreover have
	"(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B) \<subseteq>\<^sub>\<circ>
	set {[r, A, B]\<^sub>\<circ> \| r A B. r \<subseteq>\<^sub>\<circ>\<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y \<and> A \<in>\<^sub>\<circ> X \<and> B \<in>\<^sub>\<circ> Y}"
	proof(rule vsubsetI)
	fix F assume prems: "F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B)"
	then obtain A where A: "A \<in>\<^sub>\<circ> X" and F_b: "F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B)"
	unfolding vifunion_iff by auto
	then obtain B where B: "B \<in>\<^sub>\<circ> Y" and F_fba: "F \<in>\<^sub>\<circ> Hom (dg_Rel \<alpha>) A B"
	by fastforce
	then have "F : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B" by simp
	note F = dg_Rel_is_arrD[OF this]
	interpret F: arr_Rel \<alpha> F rewrites "F\<lparr>ArrDom\<rparr> = A" and "F\<lparr>ArrCod\<rparr> = B"
	by (intro F)+
	show "F \<in>\<^sub>\<circ> set {[r, A, B]\<^sub>\<circ> \| r A B. r \<subseteq>\<^sub>\<circ>\<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y \<and> A \<in>\<^sub>\<circ> X \<and> B \<in>\<^sub>\<circ> Y}"
	proof(intro in_set_CollectI small exI conjI)
	from F.arr_Rel_def show "F = [F\<lparr>ArrVal\<rparr>, A, B]\<^sub>\<circ>" unfolding F(2,3) by simp
	from A B have "A \<times>\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y" by auto
	moreover then have "F\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	by (auto simp: F.arr_Rel_ArrVal_vsubset_ArrDom_ArrCod)
	ultimately show "F\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>X \<times>\<^sub>\<circ> \<Union>\<^sub>\<circ>Y" by auto
	qed (intro A B)+
	qed
	ultimately show "(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Rel \<alpha>) A B) \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	qed

	lemma (in \<Z>) digraph_dg_Rel: "digraph \<alpha> (dg_Rel \<alpha>)"
	proof(intro digraphI)
	show "vfsequence (dg_Rel \<alpha>)" unfolding dg_Rel_def by clarsimp
	show "vcard (dg_Rel \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Rel_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_Rel \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Rel_Dom_vrange)
	show "\<R>\<^sub>\<circ> (dg_Rel \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Rel_Cod_vrange)
	qed (auto simp: dg_Rel_components dg_Rel_Hom_vifunion_in_Vset dg_Rel_Dom_vrange)



	subsection\<open>Canonical dagger for \<open>Rel\<close>\<close>


	text\<open>
	Dagger categories are exposed explicitly later.
	In the context of this section, the ``dagger'' is viewed merely as
	an explicitly defined homomorphism. A definition of a dagger functor, upon
	which the definition presented in this section is based, can be found in nLab
	\cite{noauthor_nlab_nodate}\footnote{\url{https://ncatlab.org/nlab/show/Rel})}.
	This reference also contains the majority of the results that are presented
	in this subsection.
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dghm_dag_Rel :: "V \<Rightarrow> V" (\<open>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l\<close>)
	where "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> =
	[
	vid_on (dg_Rel \<alpha>\<lparr>Obj\<rparr>),
	VLambda (dg_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel,
	op_dg (dg_Rel \<alpha>),
	dg_Rel \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dghm_dag_Rel_components:
	shows "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr> = vid_on (dg_Rel \<alpha>\<lparr>Obj\<rparr>)"
	and "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr> = VLambda (dg_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel"
	and "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomDom\<rparr> = op_dg (dg_Rel \<alpha>)"
	and "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomCod\<rparr> = dg_Rel \<alpha>"
	unfolding dghm_dag_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda dghm_dag_Rel_components(1)[folded VLambda_vid_on]
	\|vsv dghm_dag_Rel_ObjMap_vsv[dg_Rel_cs_intros]\|
	\|vdomain
	dghm_dag_Rel_ObjMap_vdomain[unfolded dg_Rel_components, dg_Rel_cs_simps]
	\|
	\|app dghm_dag_Rel_ObjMap_app[unfolded dg_Rel_components, dg_Rel_cs_simps]\|

	lemma dghm_dag_Rel_ObjMap_vrange[dg_cs_simps]: "\<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>) = Vset \<alpha>"
	unfolding dghm_dag_Rel_components dg_Rel_components by simp


	subsubsection\<open>Arrow map\<close>

	mk_VLambda dghm_dag_Rel_components(2)
	\|vsv dghm_dag_Rel_ArrMap_vsv[dg_Rel_cs_intros]\|
	\|vdomain dghm_dag_Rel_ArrMap_vdomain[dg_Rel_cs_simps]\|
	\|app dghm_dag_Rel_ArrMap_app[unfolded dg_Rel_cs_simps, dg_Rel_cs_simps]\|

	-lemma (in \<Z>) dghm_dag_Rel_ArrMap_app_vdomain[dg_cs_simps]:
	+lemma dghm_dag_Rel_ArrMap_app_vdomain[dg_cs_simps]:
	assumes "T : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	shows "\<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>) = \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof-
	from assms interpret T: arr_Rel \<alpha> T by (simp add: dg_Rel_is_arrD)
	from dg_Rel_is_arrD(1)[OF assms] show ?thesis
	by (cs_concl cs_simp: dg_Rel_cs_simps V_cs_simps converse_Rel_components(1))
	qed

	-lemmas [dg_cs_simps] = \<Z>.dghm_dag_Rel_ArrMap_app_vdomain
	-
	-lemma (in \<Z>) dghm_dag_Rel_ArrMap_app_vrange[dg_cs_simps]:
	+lemma dghm_dag_Rel_ArrMap_app_vrange[dg_cs_simps]:
	assumes "T : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	shows "\<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>) = \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof-
	from assms interpret T: arr_Rel \<alpha> T by (simp add: dg_Rel_is_arrD)
	from dg_Rel_is_arrD(1)[OF assms] show ?thesis
	by (cs_concl cs_simp: dg_Rel_cs_simps V_cs_simps converse_Rel_components(1))
	qed

	-lemmas [dg_cs_simps] = \<Z>.dghm_dag_Rel_ArrMap_app_vrange
	-
	-lemma (in \<Z>) dghm_dag_Rel_ArrMap_app_iff[dg_cs_simps]:
	+lemma dghm_dag_Rel_ArrMap_app_iff[dg_cs_simps]:
	assumes "T : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr> \<longleftrightarrow> \<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	proof-
	from assms interpret T: arr_Rel \<alpha> T by (simp add: dg_Rel_is_arrD)
	note T = dg_Rel_is_arrD[OF assms]
	note [dg_Rel_cs_simps] = converse_Rel_components
	show ?thesis
	proof(intro iffI)
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>"
	then have a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>)"
	and b: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>)"
	by auto
	with assms have a: "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" and b: "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	by (simp_all add: dg_cs_simps)
	from prems T(1) have "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"
	by (cs_prems cs_shallow cs_simp: dg_Rel_cs_simps)
	then show "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" by clarsimp
	next
	assume "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	then have "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>" by auto
	with T(1) show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr>"
	by (cs_concl cs_shallow cs_simp: dg_Rel_cs_simps)
	qed
	qed


	subsubsection\<open>Further properties\<close>

	lemma dghm_dag_Rel_ArrMap_vrange[dg_Rel_cs_simps]:
	"\<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>) = dg_Rel \<alpha>\<lparr>Arr\<rparr>"
	proof(intro vsubset_antisym vsubsetI)
	interpret ArrMap: vsv \<open>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<close>
	unfolding dghm_dag_Rel_components by simp
	fix T assume "T \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>)"
	then obtain S where T_def: "T = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>"
	and S: "S \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>)"
	by (blast dest: ArrMap.vrange_atD)
	from S show "T \<in>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Arr\<rparr>"
	by
	(
	simp add:
	T_def
	dghm_dag_Rel_components
	dg_Rel_components
	arr_Rel.arr_Rel_converse_Rel
	)
	next
	interpret ArrMap: vsv \<open>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<close>
	unfolding dghm_dag_Rel_components by simp
	fix T assume "T \<in>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Arr\<rparr>"
	then have "arr_Rel \<alpha> T" by (simp add: dg_Rel_components)
	then have "(T\<inverse>\<^sub>R\<^sub>e\<^sub>l)\<inverse>\<^sub>R\<^sub>e\<^sub>l = T" and "arr_Rel \<alpha> (T\<inverse>\<^sub>R\<^sub>e\<^sub>l)"
	by
	(
	auto simp:
	arr_Rel.arr_Rel_converse_Rel_converse_Rel arr_Rel.arr_Rel_converse_Rel
	)
	then have "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<inverse>\<^sub>R\<^sub>e\<^sub>l\<rparr> = T" "T\<inverse>\<^sub>R\<^sub>e\<^sub>l \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>)"
	by (simp_all add: dg_Rel_components(2) dghm_dag_Rel_components(2))
	then show "T \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>)" by blast
	qed

	lemma dghm_dag_Rel_ArrMap_app_is_arr:
	assumes "T : b \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> a"
	shows
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	proof(intro is_arrI)
	from assms have a: "a \<in>\<^sub>\<circ> Vset \<alpha>" and b: "b \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding dg_Rel_components by (fastforce simp: dg_Rel_components)+
	from assms have T: "arr_Rel \<alpha> T" by (auto simp: dg_Rel_is_arrD(1))
	then show dag_T: "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<in>\<^sub>\<circ> dg_Rel \<alpha>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: dg_Rel_cs_simps cs_intro: dg_Rel_cs_intros)
	from a assms T show "dg_Rel \<alpha>\<lparr>Dom\<rparr>\<lparr>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<rparr> = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_cs_simps dg_Rel_cs_simps cs_intro: dg_Rel_cs_intros
	)
	from b assms T show "dg_Rel \<alpha>\<lparr>Cod\<rparr>\<lparr>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<rparr> = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: dg_cs_simps dg_Rel_cs_simps cs_intro: dg_Rel_cs_intros
	)
	qed


	subsubsection\<open>Canonical dagger for \<open>Rel\<close> is a digraph isomorphism\<close>

	lemma (in \<Z>) dghm_dag_Rel_is_iso_dghm:
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_dg (dg_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	proof(rule is_iso_dghmI)
	interpret digraph \<alpha> \<open>dg_Rel \<alpha>\<close> by (simp add: digraph_dg_Rel)
	show "\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_dg (dg_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	proof(rule is_dghmI, unfold dg_op_simps dghm_dag_Rel_components(3,4))
	show "vfsequence (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)"
	unfolding dghm_dag_Rel_def by (simp add: nat_omega_simps)
	show "vcard (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = 4\<^sub>\<nat>"
	unfolding dghm_dag_Rel_def by (simp add: nat_omega_simps)
	fix T a b assume "T : b \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> a"
	then show
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (rule dghm_dag_Rel_ArrMap_app_is_arr)
	qed (auto simp: dghm_dag_Rel_components intro: dg_cs_intros dg_op_intros)
	show "v11 (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>)"
	proof
	(
	intro vsv.vsv_valeq_v11I,
	unfold dghm_dag_Rel_ArrMap_vdomain dg_Rel_Arr_iff
	)
	fix S T assume prems:
	"arr_Rel \<alpha> S"
	"arr_Rel \<alpha> T"
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr> = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>"
	from prems show "S = T"
	by
	(
	auto simp:
	dg_Rel_components
	dg_Rel_cs_simps
	dghm_dag_Rel_ArrMap_app[OF prems(1)]
	dghm_dag_Rel_ArrMap_app[OF prems(2)]
	)
	qed (auto intro: dg_Rel_cs_intros)
	show "\<R>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>) = dg_Rel \<alpha>\<lparr>Arr\<rparr>" by (simp add: dg_Rel_cs_simps)
	qed (simp_all add: dghm_dag_Rel_components)


	subsubsection\<open>Further properties of the canonical dagger\<close>

	lemma (in \<Z>) dghm_cn_comp_dghm_dag_Rel_dghm_dag_Rel:
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> = dghm_id (dg_Rel \<alpha>)"
	proof-
	interpret digraph \<alpha> \<open>dg_Rel \<alpha>\<close> by (simp add: digraph_dg_Rel)
	from dghm_dag_Rel_is_iso_dghm have dag:
	"\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : dg_Rel \<alpha> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	by (simp add: is_iso_dghm_def)
	show ?thesis
	proof(rule dghm_eqI)
	show "(\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr> = dghm_id (dg_Rel \<alpha>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI)
	show "vsv ((\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr>)"
	by (auto simp: dghm_cn_comp_components dghm_dag_Rel_components)
	fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr>)"
	then have a: "arr_Rel \<alpha> a"
	unfolding dg_Rel_cs_simps dghm_cn_comp_ArrMap_vdomain[OF dag dag] by simp
	from a dghm_dag_Rel_is_iso_dghm show
	"(\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = dghm_id (dg_Rel \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: dg_Rel_cs_simps dg_cs_simps dg_cn_cs_simps
	cs_intro: dg_Rel_cs_intros dghm_cs_intros
	)
	qed (simp_all add: dghm_cn_comp_components dghm_id_components dg_Rel_cs_simps)
	show "dghm_id (dg_Rel \<alpha>) : dg_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	by (simp_all add: digraph.dg_dghm_id_is_dghm digraph_axioms)
	qed
	(
	auto simp:
	dghm_cn_comp_is_dghm[OF digraph_axioms dag dag]
	dghm_cn_comp_components
	dghm_dag_Rel_components
	dghm_id_components
	)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Set.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Set.thy
	--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_Set.thy
	+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_Set.thy
	@@ -1,406 +1,413 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Set\<close> as a digraph\<close>
	theory CZH_DG_Set
	imports CZH_DG_Par
	begin



	subsection\<open>Background\<close>


	text\<open>
	\<open>Set\<close> is usually defined as a category of sets and total functions
	(see Chapter I-2 in \cite{mac_lane_categories_2010}). However, there
	is little that can prevent one from exposing \<open>Set\<close> as a digraph and
	-provide additional structure gradually in subsequent installments of this
	-work. Thus, in this section, \<open>\<alpha>\<close>-\<open>Set\<close> is defined as a digraph of sets
	+provide additional structure gradually later.
	+Thus, in this section, \<open>\<alpha>\<close>-\<open>Set\<close> is defined as a digraph of sets
	and binary relations in the set \<open>V\<^sub>\<alpha>\<close>.
	\<close>

	named_theorems dg_Set_cs_simps
	named_theorems dg_Set_cs_intros

	lemmas [dg_Set_cs_simps] = dg_Rel_shared_cs_simps
	lemmas [dg_Set_cs_intros] = dg_Rel_shared_cs_intros



	subsection\<open>Arrow for \<open>Set\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale arr_Set = \<Z> \<alpha> + vfsequence T + ArrVal: vsv \<open>T\<lparr>ArrVal\<rparr>\<close> for \<alpha> T +
	assumes arr_Set_length[dg_Rel_shared_cs_simps, dg_Set_cs_simps]:
	"vcard T = 3\<^sub>\<nat>"
	and arr_Set_ArrVal_vdomain[dg_Rel_shared_cs_simps, dg_Set_cs_simps]:
	"\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = T\<lparr>ArrDom\<rparr>"
	and arr_Set_ArrVal_vrange: "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> T\<lparr>ArrCod\<rparr>"
	and arr_Set_ArrDom_in_Vset: "T\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	and arr_Set_ArrCod_in_Vset: "T\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"

	lemmas [dg_Set_cs_simps] = arr_Set.arr_Set_ArrVal_vdomain


	text\<open>Elementary properties.\<close>

	sublocale arr_Set \<subseteq> arr_Par
	by unfold_locales
	(
	simp_all add:
	dg_Set_cs_simps
	arr_Set_ArrVal_vrange arr_Set_ArrDom_in_Vset arr_Set_ArrCod_in_Vset
	)


	text\<open>Rules.\<close>

	+lemma (in arr_Set) arr_Set_axioms'[dg_cs_intros, dg_Set_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ shows "arr_Set \<alpha>' T"
	+ unfolding assms by (rule arr_Set_axioms)
	+
	mk_ide rf arr_Set_def[unfolded arr_Set_axioms_def]
	\|intro arr_SetI\|
	\|dest arr_SetD[dest]\|
	\|elim arr_SetE[elim!]\|

	lemma (in \<Z>) arr_Set_vfsequenceI:
	assumes "vsv r"
	and "\<D>\<^sub>\<circ> r = a"
	and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> b"
	and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Set \<alpha> [r, a, b]\<^sub>\<circ>"
	by (intro arr_SetI)
	(insert assms, auto simp: arr_Rel_components nat_omega_simps)

	lemma arr_Set_arr_ParI:
	assumes "arr_Par \<alpha> T" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = T\<lparr>ArrDom\<rparr>"
	shows "arr_Set \<alpha> T"
	proof-
	interpret arr_Par \<alpha> T by (rule assms(1))
	show ?thesis
	by (intro arr_SetI)
	(
	auto simp:
	dg_Par_cs_simps
	assms(2)
	vfsequence_axioms
	arr_Rel_ArrVal_vrange
	arr_Rel_ArrDom_in_Vset
	arr_Rel_ArrCod_in_Vset
	)
	qed

	lemma arr_Set_arr_ParD:
	assumes "arr_Set \<alpha> T"
	shows "arr_Par \<alpha> T" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = T\<lparr>ArrDom\<rparr>"
	proof-
	interpret arr_Set \<alpha> T by (rule assms)
	show "arr_Par \<alpha> T" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = T\<lparr>ArrDom\<rparr>"
	by (rule arr_Par_axioms) (auto simp: dg_Set_cs_simps)
	qed

	lemma arr_Set_arr_ParE:
	assumes "arr_Set \<alpha> T"
	obtains "arr_Par \<alpha> T" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = T\<lparr>ArrDom\<rparr>"
	using assms by (auto simp: arr_Set_arr_ParD)


	-text\<open>Further elementary properties.\<close>
	+text\<open>Further properties.\<close>

	lemma arr_Set_eqI:
	assumes "arr_Set \<alpha> S"
	and "arr_Set \<alpha> T"
	and "S\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr>"
	and "S\<lparr>ArrDom\<rparr> = T\<lparr>ArrDom\<rparr>"
	and "S\<lparr>ArrCod\<rparr> = T\<lparr>ArrCod\<rparr>"
	shows "S = T"
	proof-
	interpret S: arr_Set \<alpha> S by (rule assms(1))
	interpret T: arr_Set \<alpha> T by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> S = 3\<^sub>\<nat>" by (simp add: S.vfsequence_vdomain dg_Set_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> S \<Longrightarrow> S\<lparr>a\<rparr> = T\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms)
	(auto simp: arr_field_simps)
	qed (auto simp: S.vfsequence_vdomain T.vfsequence_vdomain dg_Set_cs_simps)
	qed

	lemma small_arr_Set[simp]: "small {T. arr_Set \<alpha> T}"
	proof(rule smaller_than_small)
	show "{T. arr_Set \<alpha> T} \<subseteq> {T. arr_Par \<alpha> T}"
	by (simp add: Collect_mono arr_Set_arr_ParD(1))
	qed simp

	lemma set_Collect_arr_Set[simp]:
	"T \<in>\<^sub>\<circ> set (Collect (arr_Set \<alpha>)) \<longleftrightarrow> arr_Set \<alpha> T"
	by auto


	subsubsection\<open>Composition\<close>


	text\<open>See \cite{mac_lane_categories_2010}).\<close>

	abbreviation (input) comp_Set :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>S\<^sub>e\<^sub>t\<close> 55)
	where "comp_Set \<equiv> comp_Rel"

	lemma arr_Set_comp_Set[dg_Set_cs_intros]:
	assumes "arr_Set \<alpha> S" and "arr_Set \<alpha> T" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	shows "arr_Set \<alpha> (S \<circ>\<^sub>S\<^sub>e\<^sub>t T)"
	proof(intro arr_Set_arr_ParI)
	interpret S: arr_Set \<alpha> S by (rule assms(1))
	interpret T: arr_Set \<alpha> T by (rule assms(2))
	show "arr_Par \<alpha> (S \<circ>\<^sub>S\<^sub>e\<^sub>t T)"
	by (auto simp: S.arr_Par_axioms T.arr_Par_axioms arr_Par_comp_Par)
	show "\<D>\<^sub>\<circ> ((S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrVal\<rparr>) = (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)\<lparr>ArrDom\<rparr>"
	unfolding comp_Rel_components vdomain_vcomp_vsubset[OF assms(3)]
	by (simp add: dg_Set_cs_simps)
	qed

	+lemma arr_Set_comp_Set_ArrVal_app:
	+ assumes "arr_Set \<alpha> S"
	+ and "arr_Set \<alpha> T"
	+ and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	+ and "T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	+ shows "(S \<circ>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	+proof-
	+ interpret S: arr_Set \<alpha> S + T: arr_Set \<alpha> T by (simp_all add: assms(1,2))
	+ from assms show ?thesis
	+ unfolding comp_Rel_components by (intro vcomp_atI) auto
	+qed
	+

	subsubsection\<open>Inclusion\<close>

	abbreviation (input) incl_Set :: "V \<Rightarrow> V \<Rightarrow> V"
	where "incl_Set \<equiv> incl_Rel"

	lemma (in \<Z>) arr_Set_incl_SetI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "arr_Set \<alpha> (incl_Set A B)"
	proof(intro arr_Set_arr_ParI)
	from assms show "arr_Par \<alpha> (incl_Set A B)"
	by (force intro: arr_Par_incl_ParI)
	qed (simp add: incl_Rel_components)


	subsubsection\<open>Identity\<close>

	abbreviation (input) id_Set :: "V \<Rightarrow> V"
	where "id_Set \<equiv> id_Rel"

	lemma (in \<Z>) arr_Set_id_SetI:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "arr_Set \<alpha> (id_Set A)"
	proof(intro arr_Set_arr_ParI)
	from assms show "arr_Par \<alpha> (id_Par A)"
	by (force intro: arr_Par_id_ParI)
	qed (simp add: id_Rel_components)

	lemma arr_Set_comp_Set_id_Set_left[dg_Set_cs_simps]:
	assumes "arr_Set \<alpha> F" and "F\<lparr>ArrCod\<rparr> = A"
	- shows "id_Set A \<circ>\<^sub>R\<^sub>e\<^sub>l F = F"
	+ shows "id_Set A \<circ>\<^sub>S\<^sub>e\<^sub>t F = F"
	proof-
	interpret F: arr_Set \<alpha> F by (rule assms(1))
	have "arr_Rel \<alpha> F" by (simp add: F.arr_Rel_axioms)
	from arr_Rel_comp_Rel_id_Rel_left[OF this assms(2)] show ?thesis.
	qed

	lemma arr_Set_comp_Set_id_Set_right[dg_Set_cs_simps]:
	assumes "arr_Set \<alpha> F" and "F\<lparr>ArrDom\<rparr> = A"
	- shows "F \<circ>\<^sub>R\<^sub>e\<^sub>l id_Set A = F"
	+ shows "F \<circ>\<^sub>S\<^sub>e\<^sub>t id_Set A = F"
	proof-
	interpret F: arr_Set \<alpha> F by (rule assms(1))
	have "arr_Rel \<alpha> F" by (simp add: F.arr_Rel_axioms)
	from arr_Rel_comp_Rel_id_Rel_right[OF this assms(2)] show ?thesis.
	qed

	-lemma arr_Set_comp_Set_ArrVal:
	- assumes "arr_Set \<alpha> S"
	- and "arr_Set \<alpha> T"
	- and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	- and "T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	- shows "(S \<circ>\<^sub>S\<^sub>e\<^sub>t T)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	-proof-
	- interpret S: arr_Set \<alpha> S + T: arr_Set \<alpha> T by (simp_all add: assms(1,2))
	- from assms show ?thesis
	- unfolding comp_Rel_components by (intro vcomp_atI) auto
	-qed
	-


	subsection\<open>\<open>Set\<close> as a digraph\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition dg_Set :: "V \<Rightarrow> V"
	where "dg_Set \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Set \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma dg_Set_components:
	shows "dg_Set \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "dg_Set \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Set \<alpha> T}"
	and "dg_Set \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "dg_Set \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	unfolding dg_Set_def dg_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object\<close>

	lemma dg_Set_Obj_iff: "x \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding dg_Set_components by auto


	subsubsection\<open>Arrow\<close>

	lemma dg_Set_Arr_iff[dg_Set_cs_simps]: "x \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Arr\<rparr> \<longleftrightarrow> arr_Set \<alpha> x"
	unfolding dg_Set_components by auto


	subsubsection\<open>Domain\<close>

	mk_VLambda dg_Set_components(3)
	\|vsv dg_Set_Dom_vsv[dg_Set_cs_intros]\|
	\|vdomain dg_Set_Dom_vdomain[dg_Set_cs_simps]\|
	\|app dg_Set_Dom_app[unfolded set_Collect_arr_Set, dg_Set_cs_simps]\|

	lemma dg_Set_Dom_vrange: "\<R>\<^sub>\<circ> (dg_Set \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Set_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Set) auto


	subsubsection\<open>Codomain\<close>

	mk_VLambda dg_Set_components(4)
	\|vsv dg_Set_Cod_vsv[dg_Set_cs_intros]\|
	\|vdomain dg_Set_Cod_vdomain[dg_Set_cs_simps]\|
	\|app dg_Set_Cod_app[unfolded set_Collect_arr_Set, dg_Set_cs_simps]\|

	lemma dg_Set_Cod_vrange: "\<R>\<^sub>\<circ> (dg_Set \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Set_components
	by (rule vrange_VLambda_vsubset, unfold set_Collect_arr_Set) auto


	subsubsection\<open>Arrow with a domain and a codomain\<close>


	text\<open>Rules.\<close>

	lemma dg_Set_is_arrI[dg_Set_cs_intros]:
	assumes "arr_Set \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	shows "S : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	using assms by (intro is_arrI, unfold dg_Set_components) simp_all

	lemma dg_Set_is_arrD:
	assumes "S : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	shows "arr_Set \<alpha> S"
	and [dg_cs_simps]: "S\<lparr>ArrDom\<rparr> = A"
	and [dg_cs_simps]: "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Set_components by simp_all

	lemma dg_Set_is_arrE:
	assumes "S : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	obtains "arr_Set \<alpha> S" and "S\<lparr>ArrDom\<rparr> = A" and "S\<lparr>ArrCod\<rparr> = B"
	using is_arrD[OF assms] unfolding dg_Set_components by simp_all

	lemma dg_Set_ArrVal_vdomain[dg_Set_cs_simps, dg_cs_simps]:
	assumes "T : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	shows "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	proof-
	interpret T: arr_Set \<alpha> T using assms by (auto simp: dg_Set_is_arrD)
	from assms show ?thesis by (auto simp: dg_Set_is_arrD dg_Set_cs_simps)
	qed


	text\<open>Elementary properties.\<close>

	lemma dg_Set_ArrVal_app_vrange[dg_Set_cs_intros]:
	assumes "F : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B" and "a \<in>\<^sub>\<circ> A"
	shows "F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> B"
	proof-
	interpret F: arr_Set \<alpha> F
	rewrites "F\<lparr>ArrDom\<rparr> = A" and "F\<lparr>ArrCod\<rparr> = B"
	by (intro dg_Set_is_arrD[OF assms(1)])+
	from assms F.arr_Par_ArrVal_vrange show ?thesis
	by (auto simp: F.ArrVal.vsv_vimageI2 vsubset_iff dg_Set_cs_simps)
	qed

	lemma dg_Set_is_arr_dg_Par_is_arr:
	assumes "T : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	using assms arr_Set_arr_ParD(1)
	by (intro dg_Par_is_arrI; elim dg_Set_is_arrE) auto

	lemma dg_Set_Hom_vsubset_dg_Par_Hom:
	assumes "a \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	shows "Hom (dg_Set \<alpha>) a b \<subseteq>\<^sub>\<circ> Hom (dg_Par \<alpha>) a b"
	by (rule vsubsetI) (simp add: dg_Set_is_arr_dg_Par_is_arr)

	lemma (in \<Z>) dg_Set_incl_Set_is_arr:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<subseteq>\<^sub>\<circ> B"
	+ assumes "A \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" and "A \<subseteq>\<^sub>\<circ> B"
	shows "incl_Set A B : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B"
	proof(rule dg_Set_is_arrI)
	- show "arr_Set \<alpha> (incl_Set A B)" by (intro arr_Set_incl_SetI assms)
	-qed (simp_all add: incl_Rel_components)
	+ from assms(1,2) show "arr_Set \<alpha> (incl_Set A B)"
	+ unfolding dg_Set_components(1) by (intro arr_Set_incl_SetI assms)
	+qed (simp_all add: dg_Set_components incl_Rel_components)

	-lemma (in \<Z>) dg_Set_incl_Set_is_arr'[dg_Set_cs_intros]:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	+lemma (in \<Z>) dg_Set_incl_Set_is_arr'[dg_cs_intros, dg_Set_cs_intros]:
	+ assumes "A \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "B \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	and "A \<subseteq>\<^sub>\<circ> B"
	and "A' = A"
	and "B' = B"
	- shows "incl_Set A B : A' \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B'"
	- using assms(1-3) unfolding assms(4,5) by (rule dg_Set_incl_Set_is_arr)
	+ and "\<CC>' = dg_Set \<alpha>"
	+ shows "incl_Set A B : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1-3) unfolding assms(4-6) by (rule dg_Set_incl_Set_is_arr)

	lemmas [dg_Set_cs_intros] = \<Z>.dg_Set_incl_Set_is_arr'


	subsubsection\<open>\<open>Set\<close> is a digraph\<close>

	lemma (in \<Z>) dg_Set_Hom_vifunion_in_Vset:
	assumes "X \<in>\<^sub>\<circ> Vset \<alpha>" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Set \<alpha>) A B) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have
	"(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Set \<alpha>) A B) \<subseteq>\<^sub>\<circ>
	(\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Par \<alpha>) A B)"
	proof
	fix F assume "F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Set \<alpha>) A B)"
	then obtain B where B: "B \<in>\<^sub>\<circ> Y" and F_b:
	"F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. Hom (dg_Set \<alpha>) A B)"
	by fast
	then obtain A where A: "A \<in>\<^sub>\<circ> X" and F_AB: "F \<in>\<^sub>\<circ> Hom (dg_Set \<alpha>) A B"
	by fast
	from A B assms have "A \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" "B \<in>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>"
	unfolding dg_Set_components by auto
	from F_AB A B dg_Set_Hom_vsubset_dg_Par_Hom[OF this] show
	"F \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>X. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>Y. Hom (dg_Par \<alpha>) A B)"
	by (intro vifunionI) (auto elim!: vsubsetE simp: in_Hom_iff)
	qed
	with dg_Par_Hom_vifunion_in_Vset[OF assms] show ?thesis by blast
	qed

	lemma (in \<Z>) digraph_dg_Set: "digraph \<alpha> (dg_Set \<alpha>)"
	proof(intro digraphI)
	show "vfsequence (dg_Set \<alpha>)" unfolding dg_Set_def by simp
	show "vcard (dg_Set \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Set_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (dg_Set \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Set_Dom_vrange)
	show "\<R>\<^sub>\<circ> (dg_Set \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_Set \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_Set_Cod_vrange)
	qed (auto simp: dg_Set_components dg_Set_Hom_vifunion_in_Vset)


	subsubsection\<open>\<open>Set\<close> is a wide subdigraph of \<open>Par\<close>\<close>

	lemma (in \<Z>) wide_subdigraph_dg_Set_dg_Par: "dg_Set \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> dg_Par \<alpha>"
	proof(intro wide_subdigraphI)
	interpret Set: digraph \<alpha> \<open>dg_Set \<alpha>\<close> by (rule digraph_dg_Set)
	interpret Par: digraph \<alpha> \<open>dg_Par \<alpha>\<close> by (rule digraph_dg_Par)
	show "dg_Set \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Par \<alpha>"
	proof(intro subdigraphI, unfold dg_Set_components)
	show "F : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B" if "F : A \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> B" for F A B
	using that by (rule dg_Set_is_arr_dg_Par_is_arr)
	qed (auto simp: dg_Par_components digraph_dg_Set digraph_dg_Par)
	qed (simp_all add: dg_Par_components dg_Set_components)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_introduction/CZH_Introduction.thy b/thys/CZH_Foundations/czh_introduction/CZH_Introduction.thy
	--- a/thys/CZH_Foundations/czh_introduction/CZH_Introduction.thy
	+++ b/thys/CZH_Foundations/czh_introduction/CZH_Introduction.thy
	@@ -1,126 +1,126 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	chapter\<open>Introduction\<close>
	theory CZH_Introduction
	imports ZFC_in_HOL.ZFC_Typeclasses
	begin



	-
	section\<open>Background\<close>


	text\<open>
	This article presents a foundational framework
	that will be used for the formalization of
	elements of the theory of 1-categories in the object logic
	\<open>ZFC in HOL\<close> (\cite{paulson_zermelo_2019}, also see
	\cite{barkaoui_partizan_2006}) of the formal proof assistant
	\<open>Isabelle\<close> \cite{paulson_natural_1986} in future articles.
	It is important to note that this chapter serves as
	an introduction to the entire development and not merely
	its foundational part.

	There already exist several formalizations of the foundations of category
	theory in Isabelle. In the context of the work presented here, the most relevant
	formalizations (listed in the chronological order) are
	+\cite{caccamo_higher-order_2001-1, caccamo_higher-order_2001},
	\cite{okeefe_category_2005}, \cite{katovsky_category_2010} and
	-\cite{stark_category_2016}.
	+\cite{stark_category_2016}.
	Arguably, the most well developed and maintained entry is
	\cite{stark_category_2016}: it subsumes the majority of the content of
	\cite{okeefe_category_2005} and \cite{katovsky_category_2010}.

	From the perspective of the methodology that was chosen for the formalization,
	this work differs significantly from the aforementioned previous work.
	In particular, the categories are modelled as terms of the type \<^typ>\<open>V\<close>
	and no attempt is made to generalize the concept of a category to arbitrary
	types. The inspiration for the chosen approach is drawn from
	\cite{feferman_set-theoretical_1969},
	\cite{sica_doing_2006} and \cite{shulman_set_2008}.

	The primary references for this work are
	\<open>Categories for the Working Mathematician\<close> \cite{mac_lane_categories_2010}
	by Saunders Mac Lane, \<open>Category Theory in Context\<close>
	by Emily Riehl \cite{riehl_category_2016} and
	\<open>Categories and Functors\<close> by Bodo Pareigis \cite{bodo_categories_1970}.
	The secondary sources of information include the textbooks
	\cite{adamek_abstract_2006} and \cite{hungerford_algebra_2003},
	as well as several online encyclopedias
	(including \cite{noauthor_nlab_nodate},
	\cite{noauthor_wikipedia_2001},
	\cite{noauthor_proofwiki_nodate}
	and \cite{noauthor_encyclopedia_nodate}).
	Of course, inspiration was also drawn from the previous formalizations of
	category theory in Isabelle.

	It is likely that none of the content that is formalized in this work
	is original in nature. However, explicit citations
	are not provided for many results that were deemed to be trivial.
	\<close>




	section\<open>Related and previous work\<close>


	text\<open>
	To the best knowledge of the author, this work is the first attempt
	to develop a formalization of elements of category theory in the
	object logic ZFC in HOL by modelling categories as terms of the type \<^typ>\<open>V\<close>.
	However, it should be noted that the formalization of category theory in
	\cite{katovsky_category_2010} largely rested
	on the object logic HOL/ZF \cite{barkaoui_partizan_2006}, which is
	equiconsistent with the ZFC in HOL \cite{paulson_zermelo_2019}.
	Nonetheless, in \cite{katovsky_category_2010}, the objects and arrows
	associated with categories were modelled as terms of arbitrary
	types. The object logic HOL/ZF was used for the exposition of
	the category \<open>Set\<close> of all sets and functions between them
	and a variety of closely related concepts.
	In this sense, the methodology employed in
	\cite{katovsky_category_2010} could be seen as a combination of the
	methodology employed in this work and the methodology followed in
	\cite{okeefe_category_2005} and \cite{stark_category_2016}.
	Furthermore, in \cite{chen_hotg_2021},
	the authors have experimented with the formalization of category
	theory in Higher-Order Tarski-Grothendieck (HOTG)
	theory \cite{brown_higher-order_2019} using a methodology that
	shares many similarities with the approach that was chosen in this study.

	The formalizations of various elements of category theory
	in other proof assistants are abundant.
	While a survey of such formalizations is outside of the scope of
	this work, it is important to note that there exist at least two examples
	of the formalization of elements of category theory in a set-theoretic setting
	similar to the one that is used in this work.
	More specifically, elements of category theory were formalized in
	the Tarski-Grothendieck Set Theory in the Mizar proof assistant
	\cite{noauthor_association_nodate} (and
	published in the associated electronic journal
	\cite{grabowski_preface_2014})
	and the proof assistant Metamath
	\cite{megill_metamath_2019}.
	The following references contain some of the
	relevant articles in \cite{grabowski_preface_2014}, but the list may not be
	exhaustive:
	\cite{bylinski_introduction_1990, bylinski_subcategories_1990,
	bylinski_opposite_1991, trybulec_natural_1991,
	bylinski_category_1991, muzalewski_categories_1991,
	trybulec_isomorphisms_1991, muzalewski_category_1991,
	muzalewski_category_1991-1, bancerek_comma_1991,
	bylinski_products_1991, trybulec_isomorphisms_1992,
	bylinski_cartesian_1992, bancerek_categorial_1996,
	trybulec_categories_1996, bancerek_indexed_1996,
	trybulec_functors_1996, nieszczerzewski_category_1997,
	kornilowicz_categories_1997,
	kornilowicz_composition_1998,
	bancerek_concrete_2001,
	kornilowicz_products_2012,
	riccardi_object-free_2013,
	golinski_coproducts_2013,
	riccardi_categorical_2015,
	riccardi_exponential_2015}.
	\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_GRPH.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_GRPH.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_GRPH.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_GRPH.thy
	@@ -1,468 +1,468 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>GRPH\<close> as a semicategory\<close>
	theory CZH_SMC_GRPH
	imports
	CZH_DG_Simple
	CZH_DG_GRPH
	CZH_SMC_Small_Semicategory
	begin



	subsection\<open>Background\<close>

	text\<open>
	The methodology for the exposition of \<open>GRPH\<close> as a semicategory is analogous
	to the one used in the previous chapter for the exposition of \<open>GRPH\<close>
	as a digraph.
	\<close>

	named_theorems smc_GRPH_cs_simps
	named_theorems smc_GRPH_cs_intros



	subsection\<open>Definition and elementary properties\<close>

	definition smc_GRPH :: "V \<Rightarrow> V"
	where "smc_GRPH \<alpha> =
	[
	set {\<CC>. digraph \<alpha> \<CC>},
	all_dghms \<alpha>,
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
	(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>),
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_GRPH \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smc_GRPH_components:
	shows "smc_GRPH \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. digraph \<alpha> \<CC>}"
	and "smc_GRPH \<alpha>\<lparr>Arr\<rparr> = all_dghms \<alpha>"
	and "smc_GRPH \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
	and "smc_GRPH \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
	and "smc_GRPH \<alpha>\<lparr>Comp\<rparr> =
	(\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (dg_GRPH \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smc_dg_GRPH: "smc_dg (smc_GRPH \<alpha>) = dg_GRPH \<alpha>"
	proof(rule vsv_eqI)
	show "vsv (smc_dg (smc_GRPH \<alpha>))" unfolding smc_dg_def by auto
	show "vsv (dg_GRPH \<alpha>)" unfolding dg_GRPH_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (smc_dg (smc_GRPH \<alpha>)) = 4\<^sub>\<nat>"
	unfolding smc_dg_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (dg_GRPH \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_GRPH_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (smc_dg (smc_GRPH \<alpha>)) = \<D>\<^sub>\<circ> (dg_GRPH \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_dg (smc_GRPH \<alpha>)) \<Longrightarrow> smc_dg (smc_GRPH \<alpha>)\<lparr>a\<rparr> = dg_GRPH \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold smc_dg_def dg_field_simps smc_GRPH_def dg_GRPH_def
	)
	(auto simp: nat_omega_simps)
	qed

	lemmas_with [folded smc_dg_GRPH, unfolded slicing_simps]:
	smc_GRPH_ObjI = dg_GRPH_ObjI
	and smc_GRPH_ObjD = dg_GRPH_ObjD
	and smc_GRPH_ObjE = dg_GRPH_ObjE
	and smc_GRPH_Obj_iff[smc_GRPH_cs_simps] = dg_GRPH_Obj_iff
	and smc_GRPH_Dom_app[smc_GRPH_cs_simps] = dg_GRPH_Dom_app
	and smc_GRPH_Cod_app[smc_GRPH_cs_simps] = dg_GRPH_Cod_app
	and smc_GRPH_is_arrI = dg_GRPH_is_arrI
	and smc_GRPH_is_arrD = dg_GRPH_is_arrD
	and smc_GRPH_is_arrE = dg_GRPH_is_arrE
	and smc_GRPH_is_arr_iff[smc_GRPH_cs_simps] = dg_GRPH_is_arr_iff



	subsection\<open>Composable arrows\<close>

	lemma smc_GRPH_composable_arrs_dg_GRPH:
	"composable_arrs (dg_GRPH \<alpha>) = composable_arrs (smc_GRPH \<alpha>)"
	unfolding composable_arrs_def smc_dg_GRPH[symmetric] slicing_simps by auto

	lemma smc_GRPH_Comp:
	"smc_GRPH \<alpha>\<lparr>Comp\<rparr> = (\<lambda>\<GG>\<FF>\<in>\<^sub>\<circ>composable_arrs (smc_GRPH \<alpha>). \<GG>\<FF>\<lparr>0\<rparr> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>\<FF>\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_GRPH_components smc_GRPH_composable_arrs_dg_GRPH ..



	subsection\<open>Composition\<close>

	lemma smc_GRPH_Comp_app:
	assumes "\<GG> : \<BB> \<mapsto>\<^bsub>smc_GRPH \<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<^bsub>smc_GRPH \<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> \<FF> = \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>"
	proof-
	from assms have "[\<GG>, \<FF>]\<^sub>\<circ> \<in>\<^sub>\<circ> composable_arrs (smc_GRPH \<alpha>)"
	by (auto intro: smc_cs_intros)
	then show "\<GG> \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> \<FF> = \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>"
	unfolding smc_GRPH_Comp by (simp add: nat_omega_simps)
	qed

	lemma smc_GRPH_Comp_vdomain:
	"\<D>\<^sub>\<circ> (smc_GRPH \<alpha>\<lparr>Comp\<rparr>) = composable_arrs (smc_GRPH \<alpha>)"
	unfolding smc_GRPH_Comp by auto



	subsection\<open>\<open>GRPH\<close> is a semicategory\<close>

	lemma (in \<Z>) tiny_semicategory_smc_GRPH:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "tiny_semicategory \<beta> (smc_GRPH \<alpha>)"
	proof(intro tiny_semicategoryI, unfold smc_GRPH_is_arr_iff)
	show "vfsequence (smc_GRPH \<alpha>)" unfolding smc_GRPH_def by auto
	show "vcard (smc_GRPH \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_GRPH_def by (simp add: nat_omega_simps)
	show "(gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_GRPH \<alpha>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c \<and> f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> b)"
	for gf
	unfolding smc_GRPH_Comp_vdomain
	proof
	show "gf \<in>\<^sub>\<circ> composable_arrs (smc_GRPH \<alpha>) \<Longrightarrow>
	\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c \<and> f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> b"
	by (elim composable_arrsE) (auto simp: smc_GRPH_is_arr_iff)
	next
	assume "\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c \<and> f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> b"
	with smc_GRPH_is_arr_iff show "gf \<in>\<^sub>\<circ> composable_arrs (smc_GRPH \<alpha>)"
	unfolding smc_GRPH_Comp_vdomain by (auto intro: smc_cs_intros)
	qed
	show "\<lbrakk> g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c; f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> b \<rbrakk> \<Longrightarrow>
	g \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c"
	for g b c f a
	by (auto simp: smc_GRPH_Comp_app dghm_comp_is_dghm smc_GRPH_cs_simps)
	fix h c d g b f a
	assume "h : c \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> d" "g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c" "f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> b"
	moreover then have "g \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M f : a \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> c" "h \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M g : b \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> d"
	by (auto simp: dghm_comp_is_dghm smc_GRPH_cs_simps)
	ultimately show
	"h \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> g \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> f =
	h \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> (g \<circ>\<^sub>A\<^bsub>smc_GRPH \<alpha>\<^esub> f)"
	by (simp add: smc_GRPH_is_arr_iff smc_GRPH_Comp_app dghm_comp_assoc)
	qed (simp_all add: assms smc_dg_GRPH tiny_digraph_dg_GRPH smc_GRPH_components)



	subsection\<open>Initial object\<close>

	lemma (in \<Z>) smc_GRPH_obj_initialI: "obj_initial (smc_GRPH \<alpha>) dg_0"
	unfolding obj_initial_def
	proof
	(
	intro obj_terminalI,
	unfold smc_op_simps smc_GRPH_is_arr_iff smc_GRPH_Obj_iff
	)
	show "digraph \<alpha> dg_0" by (intro digraph_dg_0)
	fix \<AA> assume "digraph \<alpha> \<AA>"
	then interpret digraph \<alpha> \<AA> .
	show "\<exists>!f. f : dg_0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	proof
	show dghm_0: "dghm_0 \<AA> : dg_0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	by (simp add: dghm_0_is_ft_dghm digraph_axioms is_ft_dghm.axioms(1))
	fix \<FF> assume prems: "\<FF> : dg_0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	then interpret \<FF>: is_dghm \<alpha> dg_0 \<AA> \<FF> .
	show "\<FF> = dghm_0 \<AA>"
	proof(rule dghm_eqI)
	from dghm_0 show "dghm_0 \<AA> : dg_0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
	unfolding smc_GRPH_is_arr_iff by simp
	have [simp]: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = 0" by (simp add: dg_cs_simps dg_0_components)
	with \<FF>.ObjMap.vdomain_vrange_is_vempty show "\<FF>\<lparr>ObjMap\<rparr> = dghm_0 \<AA>\<lparr>ObjMap\<rparr>"
	by
	(
	auto
	intro: \<FF>.ObjMap.vsv_vrange_vempty
	simp: dg_0_components dghm_0_components
	)
	from \<FF>.dghm_ObjMap_vdomain have "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = 0"
	by
	(
	auto
	simp: \<FF>.dghm_ArrMap_vdomain
	intro: \<FF>.HomDom.dg_Arr_vempty_if_Obj_vempty
	)
	then show "\<FF>\<lparr>ArrMap\<rparr> = dghm_0 \<AA>\<lparr>ArrMap\<rparr>"
	by
	(
	metis
	\<FF>.ArrMap.vsv_axioms
	dghm_0_components(2)
	vsv.vdomain_vrange_is_vempty
	vsv.vsv_vrange_vempty
	)
	qed (auto simp: dghm_0_components prems)
	qed
	qed

	lemma (in \<Z>) smc_GRPH_obj_initialD:
	assumes "obj_initial (smc_GRPH \<alpha>) \<AA>"
	shows "\<AA> = dg_0"
	using assms unfolding obj_initial_def
	proof
	(
	elim obj_terminalE,
	unfold smc_op_simps smc_GRPH_is_arr_iff smc_GRPH_Obj_iff
	)
	assume prems: "digraph \<alpha> \<AA>" "digraph \<alpha> \<BB> \<Longrightarrow> \<exists>!\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" for \<BB>
	from prems(2)[OF digraph_dg_0] obtain \<FF> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_0"
	by meson
	interpret \<FF>: is_dghm \<alpha> \<AA> dg_0 \<FF> by (rule \<FF>)
	have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> 0"
	unfolding dg_0_components(1)[symmetric] by (simp add: \<FF>.dghm_ObjMap_vrange)
	then have "\<FF>\<lparr>ObjMap\<rparr> = 0" by (auto intro: \<FF>.ObjMap.vsv_vrange_vempty)
	with \<FF>.dghm_ObjMap_vdomain have Obj[simp]: "\<AA>\<lparr>Obj\<rparr> = 0" by auto
	have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> 0"
	unfolding dg_0_components(2)[symmetric]
	by (simp add: \<FF>.dghm_ArrMap_vrange)
	then have "\<FF>\<lparr>ArrMap\<rparr> = 0" by (auto intro: \<FF>.ArrMap.vsv_vrange_vempty)
	with \<FF>.dghm_ArrMap_vdomain have Arr[simp]: "\<AA>\<lparr>Arr\<rparr> = 0" by auto
	- from Arr \<FF>.HomDom.dg_Dom_vempty_if_Arr_vempty have [simp]: "\<AA>\<lparr>Dom\<rparr> = []\<^sub>\<circ>"
	+ from Arr \<FF>.HomDom.dg_Dom_vempty_if_Arr_vempty have [simp]: "\<AA>\<lparr>Dom\<rparr> = 0"
	by auto
	- from Arr \<FF>.HomDom.dg_Cod_vempty_if_Arr_vempty have [simp]: "\<AA>\<lparr>Cod\<rparr> = []\<^sub>\<circ>"
	+ from Arr \<FF>.HomDom.dg_Cod_vempty_if_Arr_vempty have [simp]: "\<AA>\<lparr>Cod\<rparr> = 0"
	by auto
	show "\<AA> = dg_0"
	by (rule dg_eqI[of \<alpha>]) (simp_all add: prems(1) dg_0_components digraph_dg_0)
	qed

	lemma (in \<Z>) smc_GRPH_obj_initialE:
	assumes "obj_initial (smc_GRPH \<alpha>) \<AA>"
	obtains "\<AA> = dg_0"
	using assms by (auto dest: smc_GRPH_obj_initialD)

	lemma (in \<Z>) smc_GRPH_obj_initial_iff[smc_GRPH_cs_simps]:
	"obj_initial (smc_GRPH \<alpha>) \<AA> \<longleftrightarrow> \<AA> = dg_0"
	using smc_GRPH_obj_initialI smc_GRPH_obj_initialD by auto



	subsection\<open>Terminal object\<close>

	lemma (in \<Z>) smc_GRPH_obj_terminalI[smc_GRPH_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "f \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "obj_terminal (smc_GRPH \<alpha>) (dg_1 a f)"
	proof
	(
	intro obj_terminalI,
	unfold smc_op_simps smc_GRPH_is_arr_iff smc_GRPH_Obj_iff
	)
	fix \<AA> assume "digraph \<alpha> \<AA>"
	then interpret digraph \<alpha> \<AA> .
	show "\<exists>!\<FF>'. \<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_1 a f"
	proof
	show dghm_1: "dghm_const \<AA> (dg_1 a f) a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_1 a f"
	by
	(
	auto simp:
	assms
	dg_1_is_arr_iff
	dghm_const_is_dghm
	digraph_axioms'
	digraph_dg_1
	)
	fix \<FF>' assume prems: "\<FF>' : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_1 a f"
	then interpret \<FF>': is_dghm \<alpha> \<AA> \<open>dg_1 a f\<close> \<FF>' .
	show "\<FF>' = dghm_const \<AA> (dg_1 a f) a f"
	proof(rule dghm_eqI, unfold dghm_const_components)
	show "dghm_const \<AA> (dg_1 a f) a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_1 a f" by (rule dghm_1)
	show "\<FF>'\<lparr>ObjMap\<rparr> = vconst_on (\<AA>\<lparr>Obj\<rparr>) a"
	proof(cases\<open>\<AA>\<lparr>Obj\<rparr> = 0\<close>)
	case True
	then have "\<FF>'\<lparr>ObjMap\<rparr> = 0"
	by
	(
	simp add:
	\<FF>'.ObjMap.vdomain_vrange_is_vempty
	\<FF>'.dghm_ObjMap_vsv
	vsv.vsv_vrange_vempty
	)
	with True show ?thesis by simp
	next
	case False
	then have "\<D>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>) \<noteq> 0" by (auto simp: \<FF>'.dghm_ObjMap_vdomain)
	with False have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>) \<noteq> 0" by fastforce
	moreover from \<FF>'.dghm_ObjMap_vrange have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> set {a}"
	by (simp add: dg_1_components)
	ultimately have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ObjMap\<rparr>) = set {a}" by auto
	with \<FF>'.dghm_ObjMap_vdomain show ?thesis
	by (intro vsv.vsv_is_vconst_onI) blast+
	qed
	show "\<FF>'\<lparr>ArrMap\<rparr> = vconst_on (\<AA>\<lparr>Arr\<rparr>) f"
	proof(cases\<open>\<AA>\<lparr>Arr\<rparr> = 0\<close>)
	case True
	then have "\<FF>'\<lparr>ArrMap\<rparr> = 0"
	by
	(
	simp add:
	\<FF>'.ArrMap.vdomain_vrange_is_vempty
	\<FF>'.dghm_ArrMap_vsv
	vsv.vsv_vrange_vempty
	)
	with True show ?thesis by simp
	next
	case False
	then have "\<D>\<^sub>\<circ> (\<FF>'\<lparr>ArrMap\<rparr>) \<noteq> 0" by (auto simp: \<FF>'.dghm_ArrMap_vdomain)
	with False have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ArrMap\<rparr>) \<noteq> 0"
	by (force simp: \<FF>'.ArrMap.vdomain_vrange_is_vempty)
	moreover from \<FF>'.dghm_ArrMap_vrange have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> set {f}"
	by (simp add: dg_1_components)
	ultimately have "\<R>\<^sub>\<circ> (\<FF>'\<lparr>ArrMap\<rparr>) = set {f}" by auto
	then show ?thesis
	by (intro vsv.vsv_is_vconst_onI) (auto simp: \<FF>'.dghm_ArrMap_vdomain)
	qed
	qed (auto intro: prems)
	qed
	qed (simp add: assms digraph_dg_1)

	lemma (in \<Z>) smc_GRPH_obj_terminalE:
	assumes "obj_terminal (smc_GRPH \<alpha>) \<BB>"
	obtains a f where "a \<in>\<^sub>\<circ> Vset \<alpha>" and "f \<in>\<^sub>\<circ> Vset \<alpha>" and "\<BB> = dg_1 a f"
	using assms
	proof
	(
	elim obj_terminalE;
	unfold smc_op_simps smc_GRPH_is_arr_iff smc_GRPH_Obj_iff
	)
	assume prems: "digraph \<alpha> \<BB>" "digraph \<alpha> \<AA> \<Longrightarrow> \<exists>!\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" for \<AA>
	then interpret \<BB>: digraph \<alpha> \<BB> by simp
	obtain a where \<BB>_Obj: "\<BB>\<lparr>Obj\<rparr> = set {a}" and a: "a \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have dg_10: "digraph \<alpha> (dg_10 0)" by (rule digraph_dg_10) auto
	from prems(2)[OF dg_10] obtain \<FF>
	where \<FF>: "\<FF> : dg_10 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	and \<GG>\<FF>: "\<GG> : dg_10 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB> \<Longrightarrow> \<GG> = \<FF>" for \<GG>
	by fastforce
	interpret \<FF>: is_dghm \<alpha> \<open>dg_10 0\<close> \<BB> \<FF> by (rule \<FF>)
	have "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = set {0}"
	by (simp add: dg_cs_simps dg_10_components)
	then obtain a where vrange_\<FF>[simp]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = set {a}"
	by
	(
	auto
	simp: dg_cs_simps
	intro: \<FF>.ObjMap.vsv_vdomain_vsingleton_vrange_vsingleton
	)
	with \<BB>.dg_Obj_vsubset_Vset \<FF>.dghm_ObjMap_vrange have [simp]: "a \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	from \<FF>.dghm_ObjMap_vrange have "set {a} \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by simp
	moreover have "\<BB>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> set {a}"
	proof(rule ccontr)
	assume "\<not>\<BB>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> set {a}"
	then obtain b where ba: "b \<noteq> a" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by force
	define \<GG> where "\<GG> = [set {\<langle>0, b\<rangle>}, 0, dg_10 0, \<BB>]\<^sub>\<circ>"
	have \<GG>_components:
	"\<GG>\<lparr>ObjMap\<rparr> = set {\<langle>0, b\<rangle>}"
	"\<GG>\<lparr>ArrMap\<rparr> = 0"
	"\<GG>\<lparr>HomDom\<rparr> = dg_10 0"
	"\<GG>\<lparr>HomCod\<rparr> = \<BB>"
	unfolding \<GG>_def dghm_field_simps by (simp_all add: nat_omega_simps)
	have \<GG>: "\<GG> : dg_10 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	by (rule is_dghmI, unfold \<GG>_components dg_10_components)
	(
	auto simp:
	dg_cs_intros
	nat_omega_simps
	digraph_dg_10
	\<GG>_def
	dg_10_is_arr_iff
	b
	vsubset_vsingleton_leftI
	)
	then have \<GG>_def: "\<GG> = \<FF>" by (rule \<GG>\<FF>)
	have "\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>) = set {b}" unfolding \<GG>_components by simp
	with vrange_\<FF> ba show False unfolding \<GG>_def by simp
	qed
	ultimately have "\<BB>\<lparr>Obj\<rparr> = set {a}" by simp
	with that show ?thesis by simp
	qed
	obtain f where \<BB>_Arr: "\<BB>\<lparr>Arr\<rparr> = set {f}" and f: "f \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from prems(2)[OF digraph_dg_1, of 0 0] obtain \<FF>
	where \<FF>: "\<FF> : dg_1 0 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	and \<GG>\<FF>: "\<GG> : dg_1 0 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB> \<Longrightarrow> \<GG> = \<FF>" for \<GG>
	by fastforce
	interpret \<FF>: is_dghm \<alpha> \<open>dg_1 0 0\<close> \<BB> \<FF> by (rule \<FF>)
	have "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = set {0}"
	by (simp add: dg_cs_simps dg_1_components)
	then obtain a' where "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = set {a'}"
	by
	(
	auto
	simp: dg_cs_simps
	intro: \<FF>.ObjMap.vsv_vdomain_vsingleton_vrange_vsingleton
	)
	with \<BB>_Obj \<FF>.dghm_ObjMap_vrange have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = set {a}" by auto
	have "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = set {0}" by (simp add: dg_cs_simps dg_1_components)
	then obtain f where vrange_\<FF>[simp]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = set {f}"
	by
	(
	auto
	simp: dg_cs_simps
	intro: \<FF>.ArrMap.vsv_vdomain_vsingleton_vrange_vsingleton
	)
	with \<BB>.dg_Arr_vsubset_Vset \<FF>.dghm_ArrMap_vrange have [simp]: "f \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	from \<FF>.dghm_ArrMap_vrange have "set {f} \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by simp
	moreover have "\<BB>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> set {f}"
	proof(rule ccontr)
	assume "\<not>\<BB>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> set {f}"
	then obtain g where gf: "g \<noteq> f" and g: "g \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by force
	have g: "g : a \<mapsto>\<^bsub>\<BB>\<^esub> a"
	proof(intro is_arrI)
	from g \<BB>_Obj show "\<BB>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = a"
	by (metis \<BB>.dg_is_arrD(2) is_arr_def vsingleton_iff)
	from g \<BB>_Obj show "\<BB>\<lparr>Cod\<rparr>\<lparr>g\<rparr> = a"
	by (metis \<BB>.dg_is_arrD(3) is_arr_def vsingleton_iff)
	qed (auto simp: g)
	define \<GG> where "\<GG> = [set {\<langle>0, a\<rangle>}, set {\<langle>0, g\<rangle>}, dg_1 0 0, \<BB>]\<^sub>\<circ>"
	have \<GG>_components:
	"\<GG>\<lparr>ObjMap\<rparr> = set {\<langle>0, a\<rangle>}"
	"\<GG>\<lparr>ArrMap\<rparr> = set {\<langle>0, g\<rangle>}"
	"\<GG>\<lparr>HomDom\<rparr> = dg_1 0 0"
	"\<GG>\<lparr>HomCod\<rparr> = \<BB>"
	unfolding \<GG>_def dghm_field_simps by (simp_all add: nat_omega_simps)
	have \<GG>: "\<GG> : dg_1 0 0 \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
	by (rule is_dghmI, unfold \<GG>_components dg_1_components)
	(
	auto simp:
	dg_cs_intros nat_omega_simps \<GG>_def dg_1_is_arr_iff \<BB>_Obj g
	)
	then have \<GG>_def: "\<GG> = \<FF>" by (rule \<GG>\<FF>)
	have "\<R>\<^sub>\<circ> (\<GG>\<lparr>ArrMap\<rparr>) = set {g}" unfolding \<GG>_components by simp
	with vrange_\<FF> gf show False unfolding \<GG>_def by simp
	qed
	ultimately have "\<BB>\<lparr>Arr\<rparr> = set {f}" by simp
	with that show ?thesis by simp
	qed
	have "\<BB> = dg_1 a f"
	proof(rule dg_eqI[of \<alpha>], unfold dg_1_components)
	show "\<BB>\<lparr>Obj\<rparr> = set {a}" by (simp add: \<BB>_Obj)
	moreover show "\<BB>\<lparr>Arr\<rparr> = set {f}" by (simp add: \<BB>_Arr)
	ultimately have "\<BB>\<lparr>Dom\<rparr>\<lparr>f\<rparr> = a" "\<BB>\<lparr>Cod\<rparr>\<lparr>f\<rparr> = a"
	by (metis \<BB>.dg_is_arrE is_arr_def vsingleton_iff)+
	have "\<D>\<^sub>\<circ> (\<BB>\<lparr>Dom\<rparr>) = set {f}" by (simp add: dg_cs_simps \<BB>_Arr)
	moreover from \<BB>.Dom.vsv_vrange_vempty \<BB>.dg_Dom_vdomain \<BB>.dg_Dom_vrange
	have "\<R>\<^sub>\<circ> (\<BB>\<lparr>Dom\<rparr>) = set {a}" by (fastforce simp: \<BB>_Arr \<BB>_Obj)
	ultimately show "\<BB>\<lparr>Dom\<rparr> = set {\<langle>f, a\<rangle>}"
	using \<BB>.Dom.vsv_vdomain_vrange_vsingleton by simp
	have "\<D>\<^sub>\<circ> (\<BB>\<lparr>Cod\<rparr>) = set {f}" by (simp add: dg_cs_simps \<BB>_Arr)
	moreover from \<BB>.Cod.vsv_vrange_vempty \<BB>.dg_Cod_vdomain \<BB>.dg_Cod_vrange
	have "\<R>\<^sub>\<circ> (\<BB>\<lparr>Cod\<rparr>) = set {a}"
	by (fastforce simp: \<BB>_Arr \<BB>_Obj)
	ultimately show "\<BB>\<lparr>Cod\<rparr> = set {\<langle>f, a\<rangle>}"
	using assms \<BB>.Cod.vsv_vdomain_vrange_vsingleton by simp
	qed (auto simp: dg_cs_intros \<BB>_Obj digraph_dg_1 a f)
	with a f that show ?thesis by auto
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Par.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Par.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Par.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Par.thy
	@@ -1,780 +1,796 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Par\<close> as a semicategory\<close>
	theory CZH_SMC_Par
	imports
	CZH_DG_Par
	CZH_SMC_Rel
	CZH_SMC_Subsemicategory
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition
	of \<open>Par\<close> as a semicategory is analogous to the
	one used in the previous chapter for the exposition of \<open>Par\<close> as a digraph.
	\<close>

	named_theorems smc_Par_cs_simps
	named_theorems smc_Par_cs_intros

	lemmas (in arr_Par) [smc_Par_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Par) [smc_cs_intros, smc_Par_cs_intros] =
	+ arr_Par_axioms'
	+
	lemmas [smc_Par_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Par.arr_Par_length
	arr_Par_comp_Par_id_Par_left
	arr_Par_comp_Par_id_Par_right

	lemmas [smc_Par_cs_intros] =
	dg_Rel_shared_cs_intros
	arr_Par_comp_Par



	subsection\<open>\<open>Par\<close> as a semicategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition smc_Par :: "V \<Rightarrow> V"
	where "smc_Par \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Par \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Par \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smc_Par_components:
	shows "smc_Par \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "smc_Par \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Par \<alpha> T}"
	and "smc_Par \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "smc_Par \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Par \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "smc_Par \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Par \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Par_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smc_dg_smc_Par: "smc_dg (smc_Par \<alpha>) = dg_Par \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (smc_dg (smc_Par \<alpha>)) = 4\<^sub>\<nat>"
	unfolding smc_dg_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (dg_Par \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Par_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (smc_dg (smc_Par \<alpha>)) = \<D>\<^sub>\<circ> (dg_Par \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_dg (smc_Par \<alpha>)) \<Longrightarrow> smc_dg (smc_Par \<alpha>)\<lparr>a\<rparr> = dg_Par \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold smc_dg_def dg_field_simps smc_Par_def dg_Par_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: dg_Par_def smc_dg_def)

	lemmas_with [folded smc_dg_smc_Par, unfolded slicing_simps]:
	smc_Par_Obj_iff = dg_Par_Obj_iff
	and smc_Par_Arr_iff[smc_Par_cs_simps] = dg_Par_Arr_iff
	and smc_Par_Dom_vsv[smc_Par_cs_intros] = dg_Par_Dom_vsv
	and smc_Par_Dom_vdomain[smc_Par_cs_simps] = dg_Par_Dom_vdomain
	and smc_Par_Dom_vrange = dg_Par_Dom_vrange
	and smc_Par_Dom_app[smc_Par_cs_simps] = dg_Par_Dom_app
	and smc_Par_Cod_vsv[smc_Par_cs_intros] = dg_Par_Cod_vsv
	and smc_Par_Cod_vdomain[smc_Par_cs_simps] = dg_Par_Cod_vdomain
	and smc_Par_Cod_vrange = dg_Par_Cod_vrange
	and smc_Par_Cod_app[smc_Par_cs_simps] = dg_Par_Cod_app
	and smc_Par_is_arrI = dg_Par_is_arrI
	and smc_Par_is_arrD = dg_Par_is_arrD
	and smc_Par_is_arrE = dg_Par_is_arrE

	lemmas [smc_cs_simps] = smc_Par_is_arrD(2,3)

	lemmas [smc_Par_cs_intros] = smc_Par_is_arrI

	lemmas_with (in \<Z>) [folded smc_dg_smc_Par, unfolded slicing_simps]:
	smc_Par_Hom_vifunion_in_Vset = dg_Par_Hom_vifunion_in_Vset
	and smc_Par_incl_Par_is_arr = dg_Par_incl_Par_is_arr
	and smc_Par_incl_Par_is_arr'[smc_Par_cs_intros] = dg_Par_incl_Par_is_arr'

	lemmas [smc_Par_cs_intros] = \<Z>.smc_Par_incl_Par_is_arr'


	subsubsection\<open>Composable arrows\<close>

	lemma smc_Par_composable_arrs_dg_Par:
	"composable_arrs (dg_Par \<alpha>) = composable_arrs (smc_Par \<alpha>)"
	unfolding composable_arrs_def smc_dg_smc_Par[symmetric] slicing_simps by simp

	lemma smc_Par_Comp:
	"smc_Par \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (smc_Par \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Par_components smc_Par_composable_arrs_dg_Par ..


	subsubsection\<open>Composition\<close>

	lemma smc_Par_Comp_app[smc_Par_cs_simps]:
	assumes "S : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C" and "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	shows "S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	proof-
	from assms have "[S, T]\<^sub>\<circ> \<in>\<^sub>\<circ> composable_arrs (smc_Par \<alpha>)"
	by (auto simp: smc_cs_intros)
	then show "S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	unfolding smc_Par_Comp by (simp add: nat_omega_simps)
	qed

	lemma smc_Par_Comp_vdomain: "\<D>\<^sub>\<circ> (smc_Par \<alpha>\<lparr>Comp\<rparr>) = composable_arrs (smc_Par \<alpha>)"
	unfolding smc_Par_Comp by simp

	lemma (in \<Z>) smc_Par_Comp_vrange: "\<R>\<^sub>\<circ> (smc_Par \<alpha>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> set {T. arr_Par \<alpha> T}"
	proof(rule vsubsetI)
	interpret digraph \<alpha> \<open>smc_dg (smc_Par \<alpha>)\<close>
	unfolding smc_dg_smc_Par by (simp add: digraph_dg_Par)
	fix R assume "R \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (smc_Par \<alpha>\<lparr>Comp\<rparr>)"
	then obtain ST
	where R_def: "R = smc_Par \<alpha>\<lparr>Comp\<rparr>\<lparr>ST\<rparr>"
	and "ST \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Par \<alpha>\<lparr>Comp\<rparr>)"
	unfolding smc_Par_components by (blast dest: rel_VLambda.vrange_atD)
	then obtain S T A B C
	where "ST = [S, T]\<^sub>\<circ>"
	and S: "S : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C"
	and T: "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (auto simp: smc_Par_Comp_vdomain)
	with R_def have R_def': "R = S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T" by simp
	note S_D = dg_is_arrD(1)[unfolded slicing_simps, OF S]
	and T_D = dg_is_arrD(1)[unfolded slicing_simps, OF T]
	from S_D T_D have "arr_Par \<alpha> S" "arr_Par \<alpha> T"
	by (simp_all add: smc_Par_components)
	from this show "R \<in>\<^sub>\<circ> set {T. arr_Par \<alpha> T}"
	unfolding R_def' smc_Par_Comp_app[OF S T] by (auto simp: arr_Par_comp_Par)
	qed


	subsubsection\<open>\<open>Par\<close> is a semicategory\<close>

	lemma (in \<Z>) semicategory_smc_Par: "semicategory \<alpha> (smc_Par \<alpha>)"
	proof(intro semicategoryI, unfold smc_dg_smc_Par)
	show "vfsequence (smc_Par \<alpha>)" unfolding smc_Par_def by simp
	show "vcard (smc_Par \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Par_def by (simp add: nat_omega_simps)
	show "(GF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Par \<alpha>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
	(\<exists>G F B C A. GF = [G, F]\<^sub>\<circ> \<and> G : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C \<and> F : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B)"
	for GF
	unfolding smc_Par_Comp_vdomain by (auto intro: composable_arrsI)
	show [intro]: "G \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> F : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C"
	if "G : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" for G B C F A
	proof-
	from that have "arr_Par \<alpha> G" "arr_Par \<alpha> F" by (auto elim: smc_Par_is_arrE)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Par_cs_simps
	cs_intro: smc_Par_cs_intros
	)
	qed
	show "H \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> G \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> F = H \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> (G \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> F)"
	if "H : C \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> D"
	and "G : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C"
	and "F : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	for H C D G B F A
	proof-
	from that have "arr_Par \<alpha> H" "arr_Par \<alpha> G" "arr_Par \<alpha> F"
	by (auto simp: smc_Par_is_arrD)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Par_cs_simps
	cs_intro: smc_Par_cs_intros
	)
	qed
	qed (auto simp: digraph_dg_Par smc_Par_components)


	subsubsection\<open>\<open>Par\<close> is a wide subsemicategory of \<open>Rel\<close>\<close>

	lemma (in \<Z>) wide_subsemicategory_smc_Par_smc_Rel:
	"smc_Par \<alpha> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	proof-
	interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule semicategory_smc_Rel)
	interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	show ?thesis
	proof
	(
	intro wide_subsemicategoryI subsemicategoryI,
	unfold smc_dg_smc_Par smc_dg_smc_Rel
	)
	from wide_subdigraph_dg_Par_dg_Rel show wsd:
	"dg_Par \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>" "dg_Par \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> dg_Rel \<alpha>"
	by auto
	interpret wide_subdigraph \<alpha> \<open>dg_Par \<alpha>\<close> \<open>dg_Rel \<alpha>\<close> by (rule wsd(2))
	show "G \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> F = G \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> F"
	if "G : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" for G B C F A
	proof-
	from that have "G : B \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> B"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_dg_smc_Par[symmetric] cs_intro: slicing_intros
	)+
	then have "G : B \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>dg_Rel \<alpha>\<^esub> B"
	by (cs_concl cs_shallow cs_intro: dg_sub_fw_cs_intros)+
	then have "G : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> C" and "F : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	unfolding smc_dg_smc_Rel[symmetric] slicing_simps by simp_all
	from that this show "G \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> F = G \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> F"
	by (cs_concl cs_shallow cs_simp: smc_Par_cs_simps smc_Rel_cs_simps)
	qed
	qed (auto simp: smc_cs_intros)
	qed



	subsection\<open>Monic arrow and epic arrow\<close>

	-lemma (in \<Z>) smc_Par_is_monic_arrI[intro]:
	+lemma smc_Par_is_monic_arrI[intro]:
	assumes "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" and "v11 (T\<lparr>ArrVal\<rparr>)" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	shows "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Par \<alpha>\<^esub> B"
	proof(intro is_monic_arrI)
	+
	+ interpret T: arr_Par \<alpha> T by (intro smc_Par_is_arrD(1)[OF assms(1)])
	interpret Par_Rel: wide_subsemicategory \<alpha> \<open>smc_Par \<alpha>\<close> \<open>smc_Rel \<alpha>\<close>
	- by (rule wide_subsemicategory_smc_Par_smc_Rel)
	+ by (rule T.wide_subsemicategory_smc_Par_smc_Rel)
	interpret v11: v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule assms(2))
	+
	show T: "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" by (rule assms(1))
	fix S R A'
	assume S: "S : A' \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	and R: "R : A' \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	and TS_TR: "T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S = T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R"
	from assms(3) T Par_Rel.subsemicategory_axioms have "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (intro smc_Rel_is_monic_arrI)
	(auto dest: v11.v11_vimage_vpsubset_neq elim!: smc_sub_fw_cs_intros)
	moreover from S Par_Rel.subsemicategory_axioms have "S : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from R Par_Rel.subsemicategory_axioms have "R : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from T S R TS_TR Par_Rel.subsemicategory_axioms have
	"T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S = T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R"
	by (auto simp: smc_sub_bw_cs_simps)
	ultimately show "S = R" by (rule is_monic_arrD(2))
	qed

	-lemma (in \<Z>) smc_Par_is_monic_arrD:
	+lemma smc_Par_is_monic_arrD:
	assumes "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Par \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" and "v11 (T\<lparr>ArrVal\<rparr>)" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	proof-

	from assms show T: "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" by auto
	interpret T: arr_Par \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	using T by (auto dest: smc_Par_is_arrD)

	show "v11 (T\<lparr>ArrVal\<rparr>)"
	proof(intro v11I)

	show "vsv ((T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)

	fix a b c assume "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>" and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"

	then have bar: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" and car: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" by auto
	with T.arr_Rel_ArrVal_vdomain have [intro]: "b \<in>\<^sub>\<circ> A" "c \<in>\<^sub>\<circ> A" by auto

	define R where "R = [set {\<langle>0, b\<rangle>}, set {0}, A]\<^sub>\<circ>"
	define S where "S = [set {\<langle>0, c\<rangle>}, set {0}, A]\<^sub>\<circ>"

	have R_components:
	"R\<lparr>ArrVal\<rparr> = set {\<langle>0, b\<rangle>}" "R\<lparr>ArrDom\<rparr> = set {0}" "R\<lparr>ArrCod\<rparr> = A"
	unfolding R_def by (simp_all add: arr_Rel_components)

	have S_components:
	"S\<lparr>ArrVal\<rparr> = set {\<langle>0, c\<rangle>}" "S\<lparr>ArrDom\<rparr> = set {0}" "S\<lparr>ArrCod\<rparr> = A"
	unfolding S_def by (simp_all add: arr_Rel_components)

	have R: "R : set {0} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	proof(rule smc_Par_is_arrI)
	show "arr_Par \<alpha> R"
	unfolding R_def
	- by (rule arr_Par_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	+ by (rule T.arr_Par_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: R_components)

	have S: "S : set {0} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	proof(rule smc_Par_is_arrI)
	show "arr_Par \<alpha> S"
	unfolding S_def
	- by (rule arr_Par_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	+ by (rule T.arr_Par_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: S_components)

	have "T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R = [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Par_Comp_app[OF T R]
	proof
	(
	rule arr_Par_eqI[of \<alpha>],
	unfold comp_Rel_components arr_Rel_components R_components
	)
	from R T show "arr_Par \<alpha> (T \<circ>\<^sub>R\<^sub>e\<^sub>l R)"
	by (intro arr_Par_comp_Par) (auto elim!: smc_Par_is_arrE)
	show "arr_Par \<alpha> [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	- proof(rule arr_Par_vfsequenceI)
	+ proof(rule T.arr_Par_vfsequenceI)
	from T.arr_Rel_ArrVal_vrange bar show "\<R>\<^sub>\<circ> (set {\<langle>0, a\<rangle>}) \<subseteq>\<^sub>\<circ> B" by auto
	- qed (auto simp: T.arr_Rel_ArrCod_in_Vset Axiom_of_Powers)
	+ qed (auto simp: T.arr_Rel_ArrCod_in_Vset T.Axiom_of_Powers)
	show "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>} = set {\<langle>0, a\<rangle>}"
	proof(rule vsv_eqI, unfold vdomain_vsingleton)
	from bar show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>}) = set {0}" by auto
	with bar show
	"a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>}) \<Longrightarrow>
	(T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>})\<lparr>a'\<rparr> = set {\<langle>0, a\<rangle>}\<lparr>a'\<rparr>"
	for a'
	by auto
	qed (auto intro: vsv_vcomp)
	qed simp_all

	moreover have "T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S = [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Par_Comp_app[OF T S]
	proof
	(
	rule arr_Par_eqI[of \<alpha>],
	unfold comp_Rel_components arr_Rel_components S_components
	)
	from T S show "arr_Par \<alpha> (T \<circ>\<^sub>R\<^sub>e\<^sub>l S)"
	by (intro arr_Par_comp_Par) (auto elim!: smc_Par_is_arrE)
	show "arr_Par \<alpha> [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	- proof(rule arr_Par_vfsequenceI)
	+ proof(rule T.arr_Par_vfsequenceI)
	from T.arr_Rel_ArrVal_vrange bar show "\<R>\<^sub>\<circ> (set {\<langle>0, a\<rangle>}) \<subseteq>\<^sub>\<circ> B" by auto
	- qed (auto simp: T.arr_Rel_ArrCod_in_Vset Axiom_of_Powers)
	+ qed (auto simp: T.arr_Rel_ArrCod_in_Vset T.Axiom_of_Powers)
	show "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>} = set {\<langle>0, a\<rangle>}"
	proof(rule vsv_eqI, unfold vdomain_vsingleton)
	from car show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>}) = set {0}" by auto
	with car show "a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>}) \<Longrightarrow>
	(T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>})\<lparr>a'\<rparr> = set {\<langle>0, a\<rangle>}\<lparr>a'\<rparr>"
	for a'
	by auto
	qed (auto intro: vsv_vcomp)
	qed simp_all
	ultimately have "T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S" by simp
	from assms R S this have "R = S" by blast
	with R_components(1) S_components(1) show "b = c" by simp
	qed auto

	qed auto

	show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	proof(intro vsubset_antisym vsubsetI)
	from T.arr_Rel_ArrVal_vdomain show "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<Longrightarrow> x \<in>\<^sub>\<circ> A" for x
	by auto
	fix a assume [simp]: "a \<in>\<^sub>\<circ> A" show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof(rule ccontr)
	assume a: "a \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	define R where "R = [set {\<langle>0, a\<rangle>}, set {0, 1}, A]\<^sub>\<circ>"
	define S where "S = [set {\<langle>1, a\<rangle>}, set {0, 1}, A]\<^sub>\<circ>"
	have R: "R : set {0, 1} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	proof(rule smc_Par_is_arrI)
	show "arr_Par \<alpha> R"
	unfolding R_def
	- proof(rule arr_Par_vfsequenceI)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule T.arr_Par_vfsequenceI)
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by blast
	qed (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (auto simp: R_def arr_Rel_components)
	have S: "S : set {0, 1} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	proof(rule smc_Par_is_arrI)
	show "arr_Par \<alpha> S"
	unfolding S_def
	- proof(rule arr_Par_vfsequenceI)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule T.arr_Par_vfsequenceI)
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by blast
	qed (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (auto simp: S_def arr_Rel_components)
	with a have "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> R\<lparr>ArrVal\<rparr> = 0"
	unfolding R_def arr_Rel_components
	by (intro vsubset_antisym vsubsetI) auto
	moreover with a have "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> = 0"
	unfolding S_def arr_Rel_components
	by (intro vsubset_antisym vsubsetI) auto
	ultimately have "T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S"
	using R T S
	by
	(
	intro arr_Par_eqI[of \<alpha> \<open>T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R\<close> \<open>T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S\<close>];
	elim smc_Par_is_arrE
	)
	(
	auto simp:
	dg_Par_cs_intros
	smc_Par_Comp_app[OF T R]
	smc_Par_Comp_app[OF T S]
	comp_Rel_components
	)
	from R S this assms have "R = S" by blast
	then show False unfolding R_def S_def by simp
	qed
	qed

	qed

	-lemma (in \<Z>) smc_Par_is_monic_arr:
	+lemma smc_Par_is_monic_arr:
	"T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Par \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B \<and> v11 (T\<lparr>ArrVal\<rparr>) \<and> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	by (intro iffI) (auto simp: smc_Par_is_monic_arrD smc_Par_is_monic_arrI)

	-context \<Z>
	-begin
	-
	context
	begin

	private lemma smc_Par_is_epic_arr_vsubset:
	assumes "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	and "R : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C"
	and "S : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> C"
	and "R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T"
	shows "R\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	proof
	interpret T: arr_Par \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	using assms smc_Par_is_arrD by auto
	interpret R: arr_Par \<alpha> R
	rewrites [simp]: "R\<lparr>ArrDom\<rparr> = B" and [simp]: "R\<lparr>ArrCod\<rparr> = C"
	using assms smc_Par_is_arrD by auto
	from assms(5) have "(R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr> = (S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>"
	by simp
	then have eq: "R\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	unfolding
	smc_Par_Comp_app[OF assms(3,1)]
	smc_Par_Comp_app[OF assms(4,1)]
	comp_Rel_components
	by simp
	fix bc assume prems: "bc \<in>\<^sub>\<circ> R\<lparr>ArrVal\<rparr>"
	moreover with R.ArrVal.vbrelation obtain b c where bc_def: "bc = \<langle>b, c\<rangle>" by auto
	ultimately have [simp]: "b \<in>\<^sub>\<circ> B" and "c \<in>\<^sub>\<circ> C"
	using R.arr_Rel_ArrVal_vdomain R.arr_Rel_ArrVal_vrange by auto
	note [intro] = prems[unfolded bc_def]
	have "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)" by (simp add: assms(2))
	then obtain a where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" by auto
	then have "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" unfolding eq[symmetric] by auto
	then obtain b' where ab': "\<langle>b', c\<rangle> \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" and "\<langle>a, b'\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	by clarsimp
	with ab ab' T.vsv T.ArrVal.vsv show "bc \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" unfolding bc_def by blast
	qed

	lemma smc_Par_is_epic_arrI:
	assumes "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	shows "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Par \<alpha>\<^esub> B"
	unfolding is_epic_arr_def
	proof
	(
	intro is_monic_arrI[
	of \<open>op_smc (smc_Par \<alpha>)\<close>, unfolded smc_op_simps, OF assms(1)
	]
	)

	- interpret semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	+ interpret T: arr_Par \<alpha> T
	+ rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ using assms smc_Par_is_arrD by auto
	+
	+ interpret semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule T.semicategory_smc_Par)

	fix R S a
	assume prems:
	"R : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> a"
	"S : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> a"
	"T \<circ>\<^sub>A\<^bsub>op_smc (smc_Par \<alpha>)\<^esub> R = T \<circ>\<^sub>A\<^bsub>op_smc (smc_Par \<alpha>)\<^esub> S"

	from prems(3) have RT_ST: "R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T"
	unfolding
	op_smc_Comp[OF prems(1) assms(1)]
	op_smc_Comp[OF prems(2) assms(1)]
	by simp
	from smc_Par_is_epic_arr_vsubset[OF assms(1,2) prems(1,2) this]
	have RS: "R\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>".

	from smc_Par_is_epic_arr_vsubset[OF assms(1,2) prems(2,1) RT_ST[symmetric]]
	have SR: "S\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> R\<lparr>ArrVal\<rparr>".

	from prems show "R = S"
	by (intro arr_Par_eqI[of \<alpha> R S])
	(auto simp: RS SR vsubset_antisym elim!: smc_Par_is_arrE)

	qed

	lemma smc_Par_is_epic_arrD:
	assumes "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Par \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof-

	- interpret semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	-
	from assms show T: "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	unfolding is_epic_arr_def by (auto simp: op_smc_is_arr)

	interpret T: arr_Par \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	using T by (auto elim: smc_Par_is_arrE)

	+ interpret semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule T.semicategory_smc_Par)
	+
	show "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof(intro vsubset_antisym vsubsetI)
	from T.arr_Rel_ArrVal_vrange show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<Longrightarrow> y \<in>\<^sub>\<circ> B" for y
	by auto
	fix b assume [intro]: "b \<in>\<^sub>\<circ> B" show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof(rule ccontr)
	assume prems: "b \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	define R where "R = [set {\<langle>b, 0\<rangle>}, B, set {0, 1}]\<^sub>\<circ>"
	define S where "S = [set {\<langle>b, 1\<rangle>}, B, set {0, 1}]\<^sub>\<circ>"
	have R: "R : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> set {0, 1}"
	unfolding R_def
	- proof(intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof
	+ (
	+ intro smc_Par_is_arrI T.arr_Par_vfsequenceI,
	+ unfold arr_Rel_components
	+ )
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by blast
	qed (auto simp: T.arr_Rel_ArrCod_in_Vset)
	have S: "S : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> set {0, 1}"
	unfolding S_def
	- proof(intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof
	+ (
	+ intro smc_Par_is_arrI T.arr_Par_vfsequenceI,
	+ unfold arr_Rel_components
	+ )
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by blast
	qed (auto simp: T.arr_Rel_ArrCod_in_Vset)
	from prems have "R\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = 0"
	unfolding R_def arr_Rel_components
	by (auto intro!: vsubset_antisym vsubsetI)
	moreover from prems have "S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = 0"
	unfolding S_def arr_Rel_components
	by (auto intro!: vsubset_antisym vsubsetI)
	ultimately have "R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = S \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T"
	unfolding smc_Par_Comp_app[OF R T] smc_Par_Comp_app[OF S T]
	by (simp add: R_def S_def arr_Rel_components comp_Rel_def)
	from is_epic_arrD(2)[OF assms R S this] show False
	unfolding R_def S_def by simp
	qed
	qed

	qed

	end

	-end
	-
	-lemma (in \<Z>) smc_Par_is_epic_arr:
	+lemma smc_Par_is_epic_arr:
	"T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Par \<alpha>\<^esub> B \<longleftrightarrow> T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B \<and> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	by (intro iffI) (simp_all add: smc_Par_is_epic_arrD smc_Par_is_epic_arrI)



	subsection\<open>Terminal object, initial object and null object\<close>

	lemma (in \<Z>) smc_Par_obj_terminal: "obj_terminal (smc_Par \<alpha>) A \<longleftrightarrow> A = 0"
	proof-

	interpret semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)

	have "(\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B) \<longleftrightarrow> B = 0" for B
	proof(intro iffI allI ballI)

	assume prems[rule_format]: "\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"

	then obtain T where "T : 0 \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" by (meson vempty_is_zet)
	then have [simp]: "B \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Par_components(1))

	show "B = 0"
	proof(rule ccontr)
	assume "B \<noteq> 0"
	then obtain b where "b \<in>\<^sub>\<circ> B" using trad_foundation by auto
	have "[set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ> : set {0} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	(auto simp: \<open>b \<in>\<^sub>\<circ> B\<close> vsubset_vsingleton_leftI)
	moreover have "[0, set {0}, B]\<^sub>\<circ> : set {0} \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	(auto simp: \<open>b \<in>\<^sub>\<circ> B\<close> vsubset_vsingleton_leftI)
	moreover have "[set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ> \<noteq> [0, set {0}, B]\<^sub>\<circ>" by simp
	ultimately show False
	by (metis prems smc_is_arrE smc_Par_components(1))
	qed

	next

	fix A assume [simp]: "B = 0" "A \<in>\<^sub>\<circ> Vset \<alpha>"
	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	proof(intro ex1I [of _ \<open>[0, A, 0]\<^sub>\<circ>\<close>])
	show zAz: "[0, A, 0]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by
	(
	intro smc_Par_is_arrI arr_Par_vfsequenceI,
	unfold arr_Rel_components
	)
	simp_all
	show "T = [0, A, 0]\<^sub>\<circ>" if "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" for T
	proof(rule arr_Par_eqI[of \<alpha>], unfold arr_Rel_components)
	interpret arr_Par \<alpha> T using that by (simp add: smc_Par_is_arrD(1))
	from zAz show "arr_Par \<alpha> [0, A, 0]\<^sub>\<circ>" by (auto elim: smc_Par_is_arrE)
	from arr_Par_axioms that show "T\<lparr>ArrVal\<rparr> = 0"
	by (clarsimp simp: vsv.vsv_vrange_vempty smc_Par_is_arrD(3))
	qed (use that in \<open>auto dest: smc_Par_is_arrD\<close>)
	qed

	qed

	then show ?thesis
	apply(intro iffI obj_terminalI)
	subgoal by (metis smc_is_arrD(2) obj_terminalE)
	subgoal by blast
	subgoal by (metis smc_Par_components(1))
	done

	qed

	lemma (in \<Z>) smc_Par_obj_initial: "obj_initial (smc_Par \<alpha>) A \<longleftrightarrow> A = 0"
	proof-

	interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)

	have "(\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B) \<longleftrightarrow> (A = 0)" for A
	proof(intro iffI allI ballI)

	assume prems[rule_format]: "\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"

	then obtain T where "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> 0"
	by (meson vempty_is_zet)
	then have [simp]: "A \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Par_components(1))

	show "A = 0"
	proof(rule ccontr)
	assume "A \<noteq> 0"
	then obtain a where "a \<in>\<^sub>\<circ> A" using trad_foundation by auto
	have "[set {\<langle>a, 0\<rangle>}, A, set {0}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> set {0}"
	by (intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	(auto simp: \<open>a \<in>\<^sub>\<circ> A\<close> vsubset_vsingleton_leftI)
	moreover have "[0, A, set {0}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> set {0}"
	by (intro smc_Par_is_arrI arr_Par_vfsequenceI, unfold arr_Rel_components)
	(auto simp: \<open>a \<in>\<^sub>\<circ> A\<close> vsubset_vsingleton_leftI)
	moreover have "[set {\<langle>a, 0\<rangle>}, A, set {0}]\<^sub>\<circ> \<noteq> [0, A, set {0}]\<^sub>\<circ>" by simp
	ultimately show False
	by (metis prems Par.smc_is_arrE smc_Par_components(1))
	qed

	next

	fix B assume prems[simp]: "A = 0" "B \<in>\<^sub>\<circ> Vset \<alpha>"

	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	proof(intro ex1I[of _ \<open>[0, 0, B]\<^sub>\<circ>\<close>])
	show zzB: "[0, 0, B]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by
	(
	intro smc_Par_is_arrI arr_Par_vfsequenceI,
	unfold arr_Rel_components
	)
	simp_all
	show "T = [0, 0, B]\<^sub>\<circ>" if "T : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B" for T
	proof(rule arr_Par_eqI[of \<alpha>], unfold arr_Rel_components)
	interpret arr_Par \<alpha> T using that by (simp add: smc_Par_is_arrD(1))
	show "arr_Par \<alpha> T" by (rule arr_Par_axioms)
	from zzB show "arr_Par \<alpha> [0, 0, B]\<^sub>\<circ>" by (auto elim: smc_Par_is_arrE)
	from arr_Par_axioms that show "T\<lparr>ArrVal\<rparr> = 0"
	by (elim smc_Par_is_arrE arr_ParE)
	(
	auto
	intro: ArrVal.vsv_vrange_vempty
	simp: ArrVal.vdomain_vrange_is_vempty
	)
	qed (use that in \<open>auto dest: smc_Par_is_arrD\<close>)
	qed
	qed

	then show ?thesis
	unfolding obj_initial_def
	apply(intro iffI obj_terminalI, elim obj_terminalE, unfold smc_op_simps)
	subgoal by (metis smc_Par_components(1))
	subgoal by (simp add: smc_Par_components(1))
	subgoal by (metis smc_Par_components(1))
	done

	qed

	lemma (in \<Z>) smc_Par_obj_terminal_obj_initial:
	"obj_initial (smc_Par \<alpha>) A \<longleftrightarrow> obj_terminal (smc_Par \<alpha>) A"
	unfolding smc_Par_obj_initial smc_Par_obj_terminal by simp

	lemma (in \<Z>) smc_Par_obj_null: "obj_null (smc_Par \<alpha>) A \<longleftrightarrow> A = 0"
	unfolding obj_null_def smc_Par_obj_terminal smc_Par_obj_initial by simp



	subsection\<open>Zero arrow\<close>

	lemma (in \<Z>) smc_Par_is_zero_arr:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	+ assumes "A \<in>\<^sub>\<circ> smc_Par \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> smc_Par \<alpha>\<lparr>Obj\<rparr>"
	shows "T : A \<mapsto>\<^sub>0\<^bsub>smc_Par \<alpha>\<^esub> B \<longleftrightarrow> T = [0, A, B]\<^sub>\<circ>"
	proof(intro HOL.ext iffI)
	interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	fix T A B assume "T : A \<mapsto>\<^sub>0\<^bsub>smc_Par \<alpha>\<^esub> B"
	with smc_Par_is_arrD(1) obtain R S
	where T_def: "T = R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S"
	and S: "S : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> 0"
	and R: "R : 0 \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (auto simp: arr_Par_def \<Z>.smc_Par_obj_initial obj_null_def)
	interpret S: arr_Par \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A" and [simp]: "S\<lparr>ArrCod\<rparr> = 0"
	using S smc_Par_is_arrD by auto
	interpret R: arr_Par \<alpha> R
	rewrites [simp]: "R\<lparr>ArrDom\<rparr> = 0" and [simp]: "R\<lparr>ArrCod\<rparr> = B"
	using R smc_Par_is_arrD by auto
	have S_def: "S = [0, A, 0]\<^sub>\<circ>"
	by
	(
	rule arr_Rel_eqI[of \<alpha>],
	unfold arr_Rel_components,
	insert S.arr_Rel_ArrVal_vrange S.ArrVal.vbrelation_vintersection_vrange
	)
	(
	auto simp:
	S.arr_Rel_axioms
	S.arr_Rel_ArrDom_in_Vset
	arr_Rel_vfsequenceI vbrelationI
	)
	show "T = [0, A, B]\<^sub>\<circ>"
	unfolding T_def smc_Par_Comp_app[OF R S]
	by (rule arr_Rel_eqI[of \<alpha>], unfold comp_Rel_components)
	(
	auto simp:
	\<Z>_axioms
	S_def
	R.arr_Rel_axioms
	S.arr_Rel_axioms
	arr_Rel_comp_Rel
	arr_Rel_components
	R.arr_Rel_ArrCod_in_Vset
	S.arr_Rel_ArrDom_in_Vset
	\<Z>.arr_Rel_vfsequenceI
	vbrelation_vempty
	)
	next
	fix T assume prems: "T = [0, A, B]\<^sub>\<circ>"
	let ?S = \<open>[0, A, 0]\<^sub>\<circ>\<close> and ?R = \<open>[0, 0, B]\<^sub>\<circ>\<close>
	have S: "arr_Par \<alpha> ?S" and R: "arr_Par \<alpha> ?R"
	- by (all\<open>intro arr_Par_vfsequenceI\<close>) (simp_all add: assms)
	+ by (all\<open>intro arr_Par_vfsequenceI\<close>)
	+ (simp_all add: assms[unfolded smc_Par_components])
	have SA0: "?S : A \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> 0"
	by (intro smc_Par_is_arrI) (simp_all add: S arr_Rel_components)
	moreover have R0B: "?R : 0 \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (intro smc_Par_is_arrI) (simp_all add: R arr_Rel_components)
	moreover have "T = ?R \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> ?S"
	unfolding smc_Par_Comp_app[OF R0B SA0]
	proof
	(
	rule arr_Par_eqI[of \<alpha>],
	unfold comp_Rel_components arr_Rel_components prems
	)
	show "arr_Par \<alpha> [0, A, B]\<^sub>\<circ>"
	- unfolding prems by (intro arr_Par_vfsequenceI) (auto simp: assms)
	+ unfolding prems
	+ by (intro arr_Par_vfsequenceI)
	+ (auto simp: assms[unfolded smc_Par_components])
	qed (use R S in \<open>auto simp: smc_Par_cs_intros\<close>)
	ultimately show "T : A \<mapsto>\<^sub>0\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (simp add: is_zero_arrI smc_Par_obj_null)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Rel.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Rel.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Rel.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Rel.thy
	@@ -1,1074 +1,1085 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Rel\<close> as a semicategory\<close>
	theory CZH_SMC_Rel
	imports
	CZH_DG_Rel
	CZH_SMC_Semifunctor
	CZH_SMC_Small_Semicategory
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition
	of \<open>Rel\<close> as a semicategory is analogous to the
	one used in the previous chapter for the exposition of \<open>Rel\<close> as a digraph.
	The general references for this section are Chapter I-7
	in \cite{mac_lane_categories_2010} and nLab
	\cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/Rel}
	}.
	\<close>

	named_theorems smc_Rel_cs_simps
	named_theorems smc_Rel_cs_intros

	lemmas (in arr_Rel) [smc_Rel_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Rel) [smc_cs_intros, smc_Rel_cs_intros] =
	+ arr_Rel_axioms'
	+
	lemmas [smc_Rel_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Rel.arr_Rel_length
	arr_Rel_comp_Rel_id_Rel_left
	arr_Rel_comp_Rel_id_Rel_right
	arr_Rel.arr_Rel_converse_Rel_converse_Rel
	arr_Rel_converse_Rel_eq_iff
	arr_Rel_converse_Rel_comp_Rel
	arr_Rel_comp_Rel_converse_Rel_left_if_v11
	arr_Rel_comp_Rel_converse_Rel_right_if_v11

	lemmas [smc_Rel_cs_intros] =
	dg_Rel_shared_cs_intros
	arr_Rel_comp_Rel
	arr_Rel.arr_Rel_converse_Rel



	subsection\<open>\<open>Rel\<close> as a semicategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition smc_Rel :: "V \<Rightarrow> V"
	where "smc_Rel \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Rel \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Rel \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smc_Rel_components:
	shows "smc_Rel \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "smc_Rel \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Rel \<alpha> T}"
	and "smc_Rel \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "smc_Rel \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Rel \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "smc_Rel \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Rel \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Rel_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smc_dg_smc_Rel: "smc_dg (smc_Rel \<alpha>) = dg_Rel \<alpha>"
	proof(rule vsv_eqI)
	show "vsv (smc_dg (smc_Rel \<alpha>))" unfolding smc_dg_def by auto
	show "vsv (dg_Rel \<alpha>)" unfolding dg_Rel_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (smc_dg (smc_Rel \<alpha>)) = 4\<^sub>\<nat>"
	unfolding smc_dg_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (dg_Rel \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (smc_dg (smc_Rel \<alpha>)) = \<D>\<^sub>\<circ> (dg_Rel \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_dg (smc_Rel \<alpha>)) \<Longrightarrow> smc_dg (smc_Rel \<alpha>)\<lparr>a\<rparr> = dg_Rel \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold smc_dg_def dg_field_simps smc_Rel_def dg_Rel_def
	)
	(auto simp: nat_omega_simps)
	qed

	lemmas_with [folded smc_dg_smc_Rel, unfolded slicing_simps]:
	smc_Rel_Obj_iff = dg_Rel_Obj_iff
	and smc_Rel_Arr_iff[smc_Rel_cs_simps] = dg_Rel_Arr_iff
	and smc_Rel_Dom_vsv[smc_Rel_cs_intros] = dg_Rel_Dom_vsv
	and smc_Rel_Dom_vdomain[smc_Rel_cs_simps] = dg_Rel_Dom_vdomain
	and smc_Rel_Dom_app[smc_Rel_cs_simps] = dg_Rel_Dom_app
	and smc_Rel_Dom_vrange = dg_Rel_Dom_vrange
	and smc_Rel_Cod_vsv[smc_Rel_cs_intros] = dg_Rel_Cod_vsv
	and smc_Rel_Cod_vdomain[smc_Rel_cs_simps] = dg_Rel_Cod_vdomain
	and smc_Rel_Cod_app[smc_Rel_cs_simps] = dg_Rel_Cod_app
	and smc_Rel_Cod_vrange = dg_Rel_Cod_vrange
	and smc_Rel_is_arrI[smc_Rel_cs_intros] = dg_Rel_is_arrI
	and smc_Rel_is_arrD = dg_Rel_is_arrD
	and smc_Rel_is_arrE = dg_Rel_is_arrE
	+ and smc_Rel_is_arr_ArrValE = dg_Rel_is_arr_ArrValE

	lemmas [smc_cs_simps] = smc_Rel_is_arrD(2,3)

	lemmas_with (in \<Z>) [folded smc_dg_smc_Rel, unfolded slicing_simps]:
	smc_Rel_Hom_vifunion_in_Vset = dg_Rel_Hom_vifunion_in_Vset
	and smc_Rel_incl_Rel_is_arr = dg_Rel_incl_Rel_is_arr
	and smc_Rel_incl_Rel_is_arr'[smc_Rel_cs_intros] = dg_Rel_incl_Rel_is_arr'
	- and smc_Rel_is_arr_ArrValE = dg_Rel_is_arr_ArrValE

	lemmas [smc_Rel_cs_intros] = \<Z>.smc_Rel_incl_Rel_is_arr'


	subsubsection\<open>Composable arrows\<close>

	lemma smc_Rel_composable_arrs_dg_Rel:
	"composable_arrs (dg_Rel \<alpha>) = composable_arrs (smc_Rel \<alpha>)"
	unfolding composable_arrs_def smc_dg_smc_Rel[symmetric] slicing_simps by simp

	lemma smc_Rel_Comp:
	"smc_Rel \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (smc_Rel \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Rel_components smc_Rel_composable_arrs_dg_Rel ..


	subsubsection\<open>Composition\<close>

	lemma smc_Rel_Comp_app[smc_Rel_cs_simps]:
	assumes "S : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c" and "T : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b"
	shows "S \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	proof-
	from assms have "[S, T]\<^sub>\<circ> \<in>\<^sub>\<circ> composable_arrs (smc_Rel \<alpha>)"
	by (auto intro: smc_cs_intros)
	then show "S \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	unfolding smc_Rel_Comp by (simp add: nat_omega_simps)
	qed

	lemma smc_Rel_Comp_vdomain: "\<D>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>) = composable_arrs (smc_Rel \<alpha>)"
	unfolding smc_Rel_Comp by simp

	-lemma (in \<Z>) smc_CAT_Comp_vrange:
	- "\<R>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> set {T. arr_Rel \<alpha> T}"
	+lemma (in \<Z>) smc_Rel_Comp_vrange: "\<R>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> set {T. arr_Rel \<alpha> T}"
	proof(rule vsubsetI)
	interpret digraph \<alpha> \<open>smc_dg (smc_Rel \<alpha>)\<close>
	unfolding smc_dg_smc_Rel by (simp add: digraph_dg_Rel)
	fix R assume "R \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>)"
	then obtain ST
	where R_def: "R = smc_Rel \<alpha>\<lparr>Comp\<rparr>\<lparr>ST\<rparr>"
	and "ST \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>)"
	unfolding smc_Rel_components by (auto intro: smc_cs_intros)
	then obtain S T a b c
	where "ST = [S, T]\<^sub>\<circ>"
	and S: "S : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c"
	and T: "T : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b"
	by (auto simp: smc_Rel_Comp_vdomain)
	with R_def have R_def': "R = S \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T" by simp
	note S_D = dg_is_arrD(1)[unfolded slicing_simps, OF S]
	note T_D = dg_is_arrD(1)[unfolded slicing_simps, OF T]
	from S_D T_D have "arr_Rel \<alpha> S" "arr_Rel \<alpha> T"
	by (simp_all add: smc_Rel_components)
	from this show "R \<in>\<^sub>\<circ> set {T. arr_Rel \<alpha> T}"
	unfolding R_def' smc_Rel_Comp_app[OF S T] by (auto simp: arr_Rel_comp_Rel)
	qed


	subsubsection\<open>\<open>Rel\<close> is a semicategory\<close>

	lemma (in \<Z>) semicategory_smc_Rel: "semicategory \<alpha> (smc_Rel \<alpha>)"
	proof(rule semicategoryI, unfold smc_dg_smc_Rel)
	show "vfsequence (smc_Rel \<alpha>)" unfolding smc_Rel_def by simp
	show "vcard (smc_Rel \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Rel_def by (simp add: nat_omega_simps)
	show "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Rel \<alpha>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c \<and> f : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b)"
	for gf
	unfolding smc_Rel_Comp_vdomain by (auto intro: composable_arrsI)
	show "g \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> f : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c"
	if "g : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b" for g b c f a
	proof-
	from that have "arr_Rel \<alpha> g" and "arr_Rel \<alpha> f"
	by (auto simp: smc_Rel_is_arrD(1))
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Rel_cs_simps cs_intro: smc_Rel_cs_intros
	)
	qed
	show "h \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> g \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> f = h \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> (g \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> f)"
	if "h : c \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> d"
	and "g : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b"
	for h c d g b f a
	proof-
	from that have "arr_Rel \<alpha> h" and "arr_Rel \<alpha> g" and "arr_Rel \<alpha> f"
	by (auto simp: smc_Rel_is_arrD(1))
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Rel_cs_simps
	cs_intro: smc_Rel_cs_intros
	)
	qed
	qed (auto simp: digraph_dg_Rel smc_Rel_components)



	subsection\<open>Canonical dagger for \<open>Rel\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition smcf_dag_Rel :: "V \<Rightarrow> V" (\<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l\<close>)
	where "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> =
	[
	vid_on (smc_Rel \<alpha>\<lparr>Obj\<rparr>),
	VLambda (smc_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel,
	op_smc (smc_Rel \<alpha>),
	smc_Rel \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smcf_dag_Rel_components:
	shows "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr> = vid_on (smc_Rel \<alpha>\<lparr>Obj\<rparr>)"
	and "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr> = VLambda (smc_Rel \<alpha>\<lparr>Arr\<rparr>) converse_Rel"
	and "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomDom\<rparr> = op_smc (smc_Rel \<alpha>)"
	and "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>HomCod\<rparr> = smc_Rel \<alpha>"
	unfolding smcf_dag_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smcf_dghm_smcf_dag_Rel: "smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>"
	proof(rule vsv_eqI)
	show "vsv (smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>))" unfolding smcf_dghm_def by auto
	show "vsv (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)" unfolding dghm_dag_Rel_def by auto
	have dom_lhs: "\<D>\<^sub>\<circ> (smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) = 4\<^sub>\<nat>"
	unfolding smcf_dghm_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = 4\<^sub>\<nat>"
	unfolding dghm_dag_Rel_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) = \<D>\<^sub>\<circ> (\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)) \<Longrightarrow>
	smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>a\<rparr> = \<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold dghm_field_simps[symmetric],
	unfold
	smc_dg_smc_Rel
	slicing_commute[symmetric]
	smcf_dghm_components
	dghm_dag_Rel_components
	smcf_dag_Rel_components
	dg_Rel_components
	smc_Rel_components
	)
	simp_all
	qed

	lemmas_with [
	- folded smc_dg_smc_Rel smcf_dghm_smcf_dag_Rel,
	- unfolded slicing_simps
	+ folded smc_dg_smc_Rel smcf_dghm_smcf_dag_Rel, unfolded slicing_simps
	]:
	smcf_dag_Rel_ObjMap_vsv[smc_Rel_cs_intros] = dghm_dag_Rel_ObjMap_vsv
	and smcf_dag_Rel_ObjMap_vdomain[smc_Rel_cs_simps] =
	dghm_dag_Rel_ObjMap_vdomain
	and smcf_dag_Rel_ObjMap_app[smc_Rel_cs_simps] = dghm_dag_Rel_ObjMap_app
	and smcf_dag_Rel_ObjMap_vrange[smc_Rel_cs_simps] = dghm_dag_Rel_ObjMap_vrange
	and smcf_dag_Rel_ArrMap_vsv[smc_Rel_cs_intros] = dghm_dag_Rel_ArrMap_vsv
	- and smcf_dag_Rel_ArrMap_vdomain[smc_Rel_cs_simps] = dghm_dag_Rel_ArrMap_vdomain
	+ and smcf_dag_Rel_ArrMap_vdomain[smc_Rel_cs_simps] =
	+ dghm_dag_Rel_ArrMap_vdomain
	and smcf_dag_Rel_ArrMap_app[smc_Rel_cs_simps] = dghm_dag_Rel_ArrMap_app
	- and smcf_dag_Rel_ArrMap_vrange[smc_Rel_cs_simps] = dghm_dag_Rel_ArrMap_vrange
	-
	-lemmas_with (in \<Z>) [
	- folded smc_dg_smc_Rel smcf_dghm_smcf_dag_Rel, unfolded slicing_simps
	- ]:
	- smcf_dag_Rel_app_is_arr = dghm_dag_Rel_ArrMap_app_is_arr
	and smcf_dag_Rel_ArrMap_app_vdomain[smc_cs_simps] =
	dghm_dag_Rel_ArrMap_app_vdomain
	and smcf_dag_Rel_ArrMap_app_vrange[smc_cs_simps] =
	dghm_dag_Rel_ArrMap_app_vrange
	+ and smcf_dag_Rel_ArrMap_vrange[smc_Rel_cs_simps] = dghm_dag_Rel_ArrMap_vrange
	and smcf_dag_Rel_ArrMap_app_iff[smc_cs_simps] = dghm_dag_Rel_ArrMap_app_iff
	-
	-lemmas [smc_cs_simps] =
	- \<Z>.smcf_dag_Rel_ArrMap_app_vdomain
	- \<Z>.smcf_dag_Rel_ArrMap_app_vrange
	- \<Z>.smcf_dag_Rel_ArrMap_app_iff
	+ and smcf_dag_Rel_app_is_arr = dghm_dag_Rel_ArrMap_app_is_arr


	subsubsection\<open>Canonical dagger is a contravariant isomorphism of \<open>Rel\<close>\<close>

	lemma (in \<Z>) smcf_dag_Rel_is_iso_semifunctor:
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_smc (smc_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	proof(rule is_iso_semifunctorI)
	interpret dag: is_iso_dghm \<alpha> \<open>op_dg (dg_Rel \<alpha>)\<close> \<open>dg_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>D\<^sub>G\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	by (rule dghm_dag_Rel_is_iso_dghm)
	interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close>
	by (rule semicategory_smc_Rel)
	show "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_smc (smc_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	proof
	(
	rule is_semifunctorI,
	unfold
	smc_dg_smc_Rel
	smcf_dghm_smcf_dag_Rel
	smc_op_simps
	slicing_commute[symmetric]
	smcf_dag_Rel_components(3,4)
	)
	show "vfsequence (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)"
	unfolding smcf_dag_Rel_def by (simp add: nat_omega_simps)
	show "vcard (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = 4\<^sub>\<nat>"
	unfolding smcf_dag_Rel_def by (simp add: nat_omega_simps)
	show "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> g\<rparr> =
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : c \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b" and "f : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> a"
	for g b c f a
	proof-
	from that have "arr_Rel \<alpha> g" and "arr_Rel \<alpha> f"
	by (auto simp: smc_Rel_is_arrD(1))
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Rel_cs_simps
	cs_intro: smc_Rel_cs_intros
	)
	qed
	qed (auto simp: dg_cs_intros smc_op_intros semicategory_smc_Rel)

	show "smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) :
	smc_dg (op_smc (smc_Rel \<alpha>)) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg (smc_Rel \<alpha>)"
	by
	(
	simp add:
	smc_dg_smc_Rel
	smcf_dghm_smcf_dag_Rel
	smc_op_simps
	slicing_simps
	slicing_commute[symmetric]
	dghm_dag_Rel_is_iso_dghm
	)
	-
	+
	qed


	subsubsection\<open>Further properties of the canonical dagger\<close>

	lemma (in \<Z>) smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel:
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> = smcf_id (smc_Rel \<alpha>)"
	proof(rule smcf_dghm_eqI)
	interpret semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (simp add: semicategory_smc_Rel)
	from smcf_dag_Rel_is_iso_semifunctor have dag:
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_smc (smc_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	by (simp add: is_iso_semifunctor.axioms(1))
	from smcf_cn_comp_is_semifunctor[OF semicategory_axioms dag dag] show
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : smc_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>" .
	show "smcf_id (smc_Rel \<alpha>) : smc_Rel \<alpha> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	by (auto simp: smc_smcf_id_is_semifunctor)
	show "smcf_dghm (\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>) = smcf_dghm (smcf_id (smc_Rel \<alpha>))"
	unfolding
	slicing_simps slicing_commute[symmetric]
	smc_dg_smc_Rel
	smcf_dghm_smcf_dag_Rel
	by (simp add: dghm_cn_comp_dghm_dag_Rel_dghm_dag_Rel)
	qed simp_all

	-lemma (in \<Z>) smcf_dag_Rel_ArrMap_smc_Rel_Comp:
	+lemma smcf_dag_Rel_ArrMap_smc_Rel_Comp:
	assumes "S : b \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> c" and "T : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> b"
	shows "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T\<rparr> =
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>S\<rparr>"
	proof-
	from assms have "arr_Rel \<alpha> S" and "arr_Rel \<alpha> T"
	by (auto simp: smc_Rel_is_arrD(1))
	with assms show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Rel_cs_simps cs_intro: smc_Rel_cs_intros
	)
	qed



	subsection\<open>Monic arrow and epic arrow\<close>


	text\<open>
	The conditions for an arrow of \<open>Rel\<close> to be either monic or epic are
	outlined in nLab \cite{noauthor_nlab_nodate}\footnote{
	\url{https://ncatlab.org/nlab/show/Rel}
	}.
	\<close>

	-context \<Z>
	-begin
	-
	context
	begin

	private lemma smc_Rel_is_monic_arr_vsubset:
	assumes "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "R : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	and "S : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	and "T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S"
	and "\<And>y z X.
	\<lbrakk> y \<subseteq>\<^sub>\<circ> A; z \<subseteq>\<^sub>\<circ> A; T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> y = X; T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> z = X \<rbrakk> \<Longrightarrow> y = z"
	shows "R\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	proof-
	- interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule semicategory_smc_Rel)
	interpret R: arr_Rel \<alpha> R
	rewrites "R\<lparr>ArrDom\<rparr> = A'" and "R\<lparr>ArrCod\<rparr> = A"
	- using assms(2)
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF assms(2)])+
	interpret S: arr_Rel \<alpha> S
	rewrites "S\<lparr>ArrDom\<rparr> = A'" and "S\<lparr>ArrCod\<rparr> = A"
	- using assms(3)
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF assms(3)])+
	+ interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule R.semicategory_smc_Rel)
	from assms(4) have "(T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R)\<lparr>ArrVal\<rparr> = (T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S)\<lparr>ArrVal\<rparr>"
	by simp
	then have eq: "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> R\<lparr>ArrVal\<rparr> = T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	unfolding
	smc_Rel_Comp_app[OF assms(1,2)]
	smc_Rel_Comp_app[OF assms(1,3)]
	comp_Rel_components
	by simp
	show "R\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>"
	proof(rule vsubsetI)
	fix ab assume ab[intro]: "ab \<in>\<^sub>\<circ> R\<lparr>ArrVal\<rparr>"
	with R.ArrVal.vbrelation obtain a b where ab_def: "ab = \<langle>a, b\<rangle>" by auto
	with ab R.arr_Rel_ArrVal_vrange have "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (R\<lparr>ArrVal\<rparr>)" and "b \<in>\<^sub>\<circ> A"
	by auto
	define B' and C' where "B' = R\<lparr>ArrVal\<rparr> `\<^sub>\<circ> set {a}" and "C' = T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> B'"
	have ne_C': "C' \<noteq> 0"
	proof(rule ccontr, unfold not_not)
	assume prems: "C' = 0"
	from ab have "b \<in>\<^sub>\<circ> B'" unfolding ab_def B'_def by simp
	with C'_def[unfolded prems] have b0: "T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> set {b} = 0" by auto
	from assms(5)[OF _ _ b0, of 0] \<open>b \<in>\<^sub>\<circ> A\<close> show False by auto
	qed
	have cac''[intro, simp]:
	"c \<in>\<^sub>\<circ> C' \<Longrightarrow> \<langle>a, c\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" for c
	unfolding eq[symmetric] C'_def B'_def
	by (metis vcomp_vimage vimage_vsingleton_iff)
	define A'' where "A'' = (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>) -`\<^sub>\<circ> C'"
	define B'' where "B'' = S\<lparr>ArrVal\<rparr> `\<^sub>\<circ> set {a}"
	define C'' where "C'' = T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> B''"
	have a'': "a \<in>\<^sub>\<circ> A''"
	proof-
	from ne_C' obtain c' where [intro]: "c' \<in>\<^sub>\<circ> C'"
	by (auto intro!: vsubset_antisym)
	then have "\<langle>a, c'\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" by simp
	then show ?thesis unfolding A''_def by auto
	qed
	have "C' \<subseteq>\<^sub>\<circ> C''"
	unfolding C''_def B''_def A''_def C'_def B'_def
	by (rule vsubsetI) (metis eq vcomp_vimage)
	have "C' = C''"
	proof(rule ccontr)
	assume "C' \<noteq> C''"
	with \<open>C' \<subseteq>\<^sub>\<circ> C''\<close> obtain c' where c': "c' \<in>\<^sub>\<circ> C'' -\<^sub>\<circ> C'"
	by (auto intro!: vsubset_antisym)
	then obtain b'' where "b'' \<in>\<^sub>\<circ> B''" and "\<langle>b'', c'\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	unfolding C''_def by auto
	then have "\<langle>a, c'\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> R\<lparr>ArrVal\<rparr>" unfolding eq B''_def by auto
	with c' show False unfolding B'_def C'_def by auto
	qed
	then have "T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> B'' = T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> B'" by (simp add: C''_def C'_def)
	moreover have "B' \<subseteq>\<^sub>\<circ> A" and "B'' \<subseteq>\<^sub>\<circ> A"
	using R.arr_Rel_ArrVal_vrange S.arr_Rel_ArrVal_vrange
	unfolding B'_def B''_def
	by auto
	ultimately have "B'' = B'" by (simp add: assms(5))
	with ab have "b \<in>\<^sub>\<circ> B''" unfolding B'_def ab_def by simp
	then show "ab \<in>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" unfolding ab_def B''_def by simp
	qed
	qed

	lemma smc_Rel_is_monic_arrI:
	assumes "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "\<And>y z X. \<lbrakk> y \<subseteq>\<^sub>\<circ> A; z \<subseteq>\<^sub>\<circ> A; T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> y = X; T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> z = X \<rbrakk> \<Longrightarrow>
	y = z"
	shows "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof(rule is_monic_arrI)

	- interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (simp add: semicategory_smc_Rel)
	+ interpret T: arr_Rel \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Rel_is_arrD[OF assms(1)])+

	- fix R S A'
	- assume prems:
	+ interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (simp add: T.semicategory_smc_Rel)
	+
	+ fix R S A' assume prems:
	"R : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	"S : A' \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	"T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S"

	- interpret T: arr_Rel \<alpha> T
	- rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	- using assms(1)
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	interpret R: arr_Rel \<alpha> R
	rewrites [simp]: "R\<lparr>ArrDom\<rparr> = A'" and [simp]: "R\<lparr>ArrCod\<rparr> = A"
	- using prems(1)
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF prems(1)])+
	interpret S: arr_Rel \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A'" and [simp]: "S\<lparr>ArrCod\<rparr> = A"
	- using prems(2)
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF prems(2)])+

	from assms prems have
	"R\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> S\<lparr>ArrVal\<rparr>" "S\<lparr>ArrVal\<rparr> \<subseteq>\<^sub>\<circ> R\<lparr>ArrVal\<rparr>"
	by (auto simp: smc_Rel_is_monic_arr_vsubset)
	then show "R = S"
	using R.arr_Rel_axioms S.arr_Rel_axioms
	by (intro arr_Rel_eqI[of \<alpha> R S]) auto

	qed (rule assms(1))

	end

	-end
	-
	-lemma (in \<Z>) smc_Rel_is_monic_arrD[dest]:
	+lemma smc_Rel_is_monic_arrD[dest]:
	assumes "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "y \<subseteq>\<^sub>\<circ> A"
	and "z \<subseteq>\<^sub>\<circ> A"
	and "T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> y = X"
	and "T\<lparr>ArrVal\<rparr> `\<^sub>\<circ> z = X"
	shows "y = z"
	proof-

	- interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (simp add: semicategory_smc_Rel)
	+ from assms have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B" by (simp add: is_monic_arr_def)

	- from assms have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B" by (simp add: is_monic_arr_def)
	interpret T: arr_Rel \<alpha> T
	rewrites "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	- using T
	- by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF T])+
	+
	+ interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close>
	+ by (simp add: T.semicategory_smc_Rel)

	define R where "R = [set {0} \<times>\<^sub>\<circ> y, set {0}, A]\<^sub>\<circ>"
	define S where "S = [set {0} \<times>\<^sub>\<circ> z, set {0}, A]\<^sub>\<circ>"

	have R: "R : set {0} \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	proof(intro smc_Rel_is_arrI)
	show "arr_Rel \<alpha> R"
	unfolding R_def
	- proof(intro arr_Rel_vfsequenceI)
	+ proof(intro T.arr_Rel_vfsequenceI)
	from assms(2) show "\<R>\<^sub>\<circ> (set {0} \<times>\<^sub>\<circ> y) \<subseteq>\<^sub>\<circ> A" by auto
	qed (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: R_def arr_Rel_components)

	from assms(3) have S: "S : set {0} \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	proof(intro smc_Rel_is_arrI)
	show "arr_Rel \<alpha> S"
	unfolding S_def
	- proof(intro arr_Rel_vfsequenceI)
	+ proof(intro T.arr_Rel_vfsequenceI)
	from assms(3) show "\<R>\<^sub>\<circ> (set {0} \<times>\<^sub>\<circ> z) \<subseteq>\<^sub>\<circ> A" by auto
	qed (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: S_def arr_Rel_components)

	from assms(4) have "T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R = [set {0} \<times>\<^sub>\<circ> X, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Rel_Comp_app[OF T R]
	unfolding comp_Rel_components R_def comp_Rel_def arr_Rel_components
	by (simp add: vcomp_vimage_vtimes_right)
	moreover from assms have "T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S = [set {0} \<times>\<^sub>\<circ> X, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Rel_Comp_app[OF T S]
	unfolding comp_Rel_components S_def comp_Rel_def arr_Rel_components
	by (simp add: vcomp_vimage_vtimes_right)
	ultimately have "T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S" by simp
	from R S assms(1) this have "R = S" by (elim is_monic_arrE)
	then show "y = z" unfolding R_def S_def by auto

	qed

	-lemma (in \<Z>) smc_Rel_is_monic_arr:
	+lemma smc_Rel_is_monic_arr:
	"T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B \<and>
	(
	\<forall>y z X.
	y \<subseteq>\<^sub>\<circ> A \<longrightarrow>
	z \<subseteq>\<^sub>\<circ> A \<longrightarrow>
	(T\<lparr>ArrVal\<rparr>) `\<^sub>\<circ> y = X \<longrightarrow>
	(T\<lparr>ArrVal\<rparr>) `\<^sub>\<circ> z = X \<longrightarrow>
	y = z
	)"
	by (rule iffI allI impI)
	(auto simp: smc_Rel_is_monic_arrD smc_Rel_is_monic_arrI)

	-lemma (in \<Z>) smc_Rel_is_monic_arr_is_epic_arr:
	+lemma smc_Rel_is_monic_arr_is_epic_arr:
	assumes "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "(\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> A"
	shows "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof-

	+ interpret T: arr_Rel \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Rel_is_arrD[OF assms(1)])+
	+
	interpret is_iso_semifunctor \<alpha> \<open>op_smc (smc_Rel \<alpha>)\<close> \<open>smc_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	- rewrites "(op_smc \<CC>')\<lparr>Obj\<rparr> = \<CC>'\<lparr>Obj\<rparr>"
	- and "(op_smc \<CC>')\<lparr>Arr\<rparr> = \<CC>'\<lparr>Arr\<rparr>"
	+ rewrites "op_smc \<CC>'\<lparr>Obj\<rparr> = \<CC>'\<lparr>Obj\<rparr>"
	+ and "op_smc \<CC>'\<lparr>Arr\<rparr> = \<CC>'\<lparr>Arr\<rparr>"
	and "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b"
	for \<CC>' f a b
	- unfolding smc_op_simps by (auto simp: smcf_dag_Rel_is_iso_semifunctor)
	+ unfolding smc_op_simps by (auto simp: T.smcf_dag_Rel_is_iso_semifunctor)

	show ?thesis
	proof(intro HomCod.is_epic_arrI)

	show T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B" by (rule assms(1))

	fix f g a assume prems:
	"f : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> a"
	"g : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> a"
	"f \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T = g \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T"

	from prems(1) have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	by (auto intro: smc_cs_intros)
	with prems(1) HomCod.smc_is_arrD(3) T have dag_f:
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	unfolding smcf_dag_Rel_components(1) by auto
	from prems(2) have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
	by (auto intro: smc_cs_intros)
	with prems(2) have dag_g: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	unfolding smcf_dag_Rel_components(1)
	by (metis HomCod.smc_is_arrD(3) T vid_on_eq_atI)
	from prems T have
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	by (simp add: smcf_dag_Rel_ArrMap_smc_Rel_Comp[symmetric])
	from is_monic_arrD(2)[OF assms(2) dag_f dag_g this] show "f = g"
	by (meson prems HomDom.smc_is_arrD(1) ArrMap.v11_eq_iff)

	qed
	qed

	-lemma (in \<Z>) smc_Rel_is_epic_arr_is_monic_arr:
	+lemma smc_Rel_is_epic_arr_is_monic_arr:
	assumes "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B"
	shows "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> A"
	proof(rule is_monic_arrI)

	+ from assms(1) have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	+ by (simp add: is_epic_arr_def is_monic_arr_def smc_op_simps)
	+
	+ interpret T: arr_Rel \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Rel_is_arrD[OF T])+
	+
	interpret is_iso_semifunctor \<alpha> \<open>op_smc (smc_Rel \<alpha>)\<close> \<open>smc_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f a b
	- unfolding smc_op_simps by (auto simp: smcf_dag_Rel_is_iso_semifunctor)
	+ unfolding smc_op_simps by (auto simp: T.smcf_dag_Rel_is_iso_semifunctor)

	have dag: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> : op_smc (smc_Rel \<alpha>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> smc_Rel \<alpha>"
	by (auto intro: smc_cs_intros)

	from HomCod.is_epic_arrD(1)[OF assms] have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B".

	from T have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	by (auto intro: smc_cs_intros)
	with T show dag_T: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	unfolding smcf_dag_Rel_components(1)
	by (metis HomCod.smc_is_arrD(2) HomCod.smc_is_arrD(3) vid_on_eq_atI)

	- fix f g a :: V
	- assume prems:
	+ fix f g a assume prems:
	"f : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	"g : a \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> f = \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> g"
	then have a: "a \<in>\<^sub>\<circ> smc_Rel \<alpha>\<lparr>Obj\<rparr>" by auto
	from prems(1) have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (auto intro: smc_cs_intros)
	with prems(1) have dag_f: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> a"
	by (cs_concl cs_intro: smc_cs_intros cs_simp: smc_Rel_cs_simps)
	from prems(2) have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_intro: smc_cs_intros cs_simp:)
	with prems(2) have dag_g: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> a"
	by (cs_concl cs_intro: smc_cs_intros cs_simp: smc_Rel_cs_simps)
	from T dag have
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<rparr> =
	(\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>"
	by
	(
	cs_concl
	cs_intro: smc_cs_intros
	cs_simp: smc_Rel_cs_simps smc_cn_cs_simps smc_cs_simps
	)
	also from T have "\<dots> = T"
	- unfolding dghm_id_components smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel by auto
	+ unfolding dghm_id_components T.smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel
	+ by auto
	finally have dag_dag_T: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<rparr> = T" by simp
	have
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T = \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> T"
	by (metis dag_T dag_dag_T prems smcf_dag_Rel_ArrMap_smc_Rel_Comp)
	from HomCod.is_epic_arrD(2)[OF assms dag_f dag_g this] prems ArrMap.v11_eq_iff
	show "f = g"
	by blast

	qed

	-lemma (in \<Z>) smc_Rel_is_epic_arrI:
	+lemma smc_Rel_is_epic_arrI:
	assumes "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "\<And>y z X. \<lbrakk> y \<subseteq>\<^sub>\<circ> B; z \<subseteq>\<^sub>\<circ> B; T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> y = X; T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> z = X \<rbrakk> \<Longrightarrow>
	y = z"
	shows "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof-
	+
	+ interpret T: arr_Rel \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Rel_is_arrD[OF assms(1)])+
	+
	interpret is_iso_semifunctor \<alpha> \<open>op_smc (smc_Rel \<alpha>)\<close> \<open>smc_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f a b
	- unfolding smc_op_simps by (auto simp: smcf_dag_Rel_is_iso_semifunctor)
	- from assms have T: "arr_Rel \<alpha> T" by (auto simp: smc_Rel_is_arrD(1))
	+ unfolding smc_op_simps by (auto simp: T.smcf_dag_Rel_is_iso_semifunctor)
	+
	have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> A"
	proof(rule smc_Rel_is_monic_arrI)
	from assms(1) have "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> :
	\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr> \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> \<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	by (cs_concl cs_shallow cs_intro: smc_cs_intros)
	with assms(1) show "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> A"
	by (cs_concl cs_intro: smc_cs_intros cs_simp: smc_Rel_cs_simps)
	fix y z X
	assume
	"y \<subseteq>\<^sub>\<circ> B"
	"z \<subseteq>\<^sub>\<circ> B"
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr> `\<^sub>\<circ> y = X"
	"\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr>\<lparr>ArrVal\<rparr> `\<^sub>\<circ> z = X"
	then show "y = z"
	unfolding
	converse_Rel_components
	- smcf_dag_Rel_ArrMap_app[OF T]
	+ smcf_dag_Rel_ArrMap_app[OF T.arr_Rel_axioms]
	app_invimage_def[symmetric]
	by (rule assms(2))
	qed
	from smc_Rel_is_monic_arr_is_epic_arr[OF assms(1) this] show ?thesis by simp
	qed

	-lemma (in \<Z>) smc_Rel_is_epic_arrD[dest]:
	+lemma smc_Rel_is_epic_arrD[dest]:
	assumes "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B"
	and "y \<subseteq>\<^sub>\<circ> B"
	and "z \<subseteq>\<^sub>\<circ> B"
	and "T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> y = X"
	and "T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> z = X"
	shows "y = z"
	proof-
	+
	+ from assms(1) have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	+ by (simp add: is_epic_arr_def is_monic_arr_def smc_op_simps)
	+
	+ interpret T: arr_Rel \<alpha> T
	+ rewrites "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Rel_is_arrD[OF T])+
	+
	interpret is_iso_semifunctor \<alpha> \<open>op_smc (smc_Rel \<alpha>)\<close> \<open>smc_Rel \<alpha>\<close> \<open>\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<close>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b"
	for \<CC>' f a b
	- unfolding smc_op_simps by (auto simp: smcf_dag_Rel_is_iso_semifunctor)
	+ unfolding smc_op_simps by (auto simp: T.smcf_dag_Rel_is_iso_semifunctor)
	have dag_T: "\<dagger>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>R\<^sub>e\<^sub>l \<alpha>\<lparr>ArrMap\<rparr>\<lparr>T\<rparr> : B \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Rel \<alpha>\<^esub> A"
	by (rule smc_Rel_is_epic_arr_is_monic_arr[OF assms(1)])
	from HomCod.is_epic_arrD(1)[OF assms(1)] have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B".
	then have T: "arr_Rel \<alpha> T" by (auto simp: smc_Rel_is_arrD(1))
	from
	assms(4,5)
	smc_Rel_is_monic_arrD
	[
	OF dag_T assms(2,3),
	unfolded
	smc_dg_smc_Rel
	smcf_dghm_smcf_dag_Rel
	converse_Rel_components
	smcf_dag_Rel_ArrMap_app[OF T]
	]
	show ?thesis
	by (auto simp: app_invimage_def)
	qed

	-lemma (in \<Z>) smc_Rel_is_epic_arr:
	+lemma smc_Rel_is_epic_arr:
	"T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B \<and>
	(
	\<forall>y z X.
	y \<subseteq>\<^sub>\<circ> B \<longrightarrow>
	z \<subseteq>\<^sub>\<circ> B \<longrightarrow>
	T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> y = X \<longrightarrow>
	T\<lparr>ArrVal\<rparr> -`\<^sub>\<circ> z = X \<longrightarrow>
	y = z
	)"
	proof(intro iffI allI impI conjI)
	show "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Rel \<alpha>\<^esub> B \<Longrightarrow> T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (simp add: is_epic_arr_def is_monic_arr_def op_smc_is_arr)
	qed (auto simp: smc_Rel_is_epic_arrI)



	subsection\<open>Terminal object, initial object and null object\<close>


	text\<open>
	An object in the semicategory \<open>Rel\<close> is terminal/initial/null if and only if
	it is the empty set (see
	nLab \cite{noauthor_nlab_nodate})\footnote{
	\url{https://ncatlab.org/nlab/show/database+of+categories}
	}.
	\<close>

	lemma (in \<Z>) smc_Rel_obj_terminal: "obj_terminal (smc_Rel \<alpha>) A \<longleftrightarrow> A = 0"
	proof-

	interpret semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule semicategory_smc_Rel)

	have "(\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B) \<longleftrightarrow> B = 0" for B
	proof(intro iffI allI ballI)

	assume prems[rule_format]: "\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"

	then obtain T where "T : 0 \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B" by (meson vempty_is_zet)
	then have [simp]: "B \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Rel_components(1))

	show "B = 0"
	proof(rule ccontr)
	assume "B \<noteq> 0"
	with trad_foundation obtain b where "b \<in>\<^sub>\<circ> B" by auto
	let ?b0B = \<open>[set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ>\<close>
	let ?z0B = \<open>[0, set {0}, B]\<^sub>\<circ>\<close>
	have "?b0B : set {0} \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof(intro smc_Rel_is_arrI)
	show b0B: "arr_Rel \<alpha> ?b0B"
	by (intro arr_Rel_vfsequenceI)
	(force simp: \<open>b \<in>\<^sub>\<circ> B\<close> vsubset_vsingleton_leftI)+
	qed (simp_all add: arr_Rel_components)
	moreover have "?z0B : set {0} \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof(intro smc_Rel_is_arrI)
	show b0B: "arr_Rel \<alpha> ?z0B"
	by (intro arr_Rel_vfsequenceI)
	(force simp: \<open>b \<in>\<^sub>\<circ> B\<close> vsubset_vsingleton_leftI)+
	qed (simp_all add: arr_Rel_components)
	moreover have "[set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ> \<noteq> [0, set {0}, B]\<^sub>\<circ>" by simp
	ultimately show False
	by (metis prems smc_is_arrE smc_Rel_components(1))
	qed

	next

	fix A assume prems[simp]: "B = 0" "A \<in>\<^sub>\<circ> Vset \<alpha>"
	let ?zAz = \<open>[0, A, 0]\<^sub>\<circ>\<close>
	have zAz: "arr_Rel \<alpha> ?zAz"
	by
	(
	simp add:
	\<Z>.arr_Rel_vfsequenceI
	\<Z>_axioms
	smc_Rel_components(2)
	vbrelation_vempty
	)

	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof(rule ex1I[of _ \<open>?zAz\<close>])
	show "?zAz : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (intro smc_Rel_is_arrI)
	(
	simp_all add:
	zAz
	smc_Rel_Dom_app[OF zAz]
	smc_Rel_Cod_app[OF zAz]
	arr_Rel_components
	)
	fix T assume "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	then have T: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> 0" by simp
	then interpret T: arr_Rel \<alpha> T by (fastforce simp: smc_Rel_components(2))
	show "T = [0, A, 0]\<^sub>\<circ>"
	proof
	(
	subst T.arr_Rel_def,
	rule arr_Rel_eqI[of \<alpha>],
	unfold arr_Rel_components
	)
	show "arr_Rel \<alpha> [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"
	by (fold T.arr_Rel_def) (simp add: T.arr_Rel_axioms)
	from zAz show "arr_Rel \<alpha> ?zAz"
	by (simp add: arr_Rel_vfsequenceI vbrelationI)
	from T have "T \<in>\<^sub>\<circ> smc_Rel \<alpha>\<lparr>Arr\<rparr>" by (auto intro: smc_cs_intros)
	with is_arrD(2,3)[OF T] show "T\<lparr>ArrDom\<rparr> = A" "T\<lparr>ArrCod\<rparr> = 0"
	using T smc_Rel_is_arrD(2,3) by auto
	with T.arr_Rel_ArrVal_vrange T.ArrVal.vbrelation_vintersection_vrange
	- show "T\<lparr>ArrVal\<rparr> = []\<^sub>\<circ>"
	+ show "T\<lparr>ArrVal\<rparr> = 0"
	by auto
	qed

	qed

	qed

	then show ?thesis
	apply(intro iffI obj_terminalI)
	subgoal by (metis smc_is_arrD(2) obj_terminalE)
	subgoal by blast
	subgoal by (metis smc_Rel_components(1))
	done

	qed

	(TODO: generalize: duality/dagger)
	lemma (in \<Z>) smc_Rel_obj_initial: "obj_initial (smc_Rel \<alpha>) A \<longleftrightarrow> A = 0"
	proof-

	interpret semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule semicategory_smc_Rel)

	have "(\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B) \<longleftrightarrow> A = 0" for A
	proof(intro iffI allI ballI)

	assume prems[rule_format]: "\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"

	then obtain T where TA0: "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> 0" by (meson vempty_is_zet)
	then have [simp]: "A \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Rel_components(1))

	show "A = 0"
	proof(rule ccontr)
	assume "A \<noteq> 0"
	with trad_foundation obtain a where "a \<in>\<^sub>\<circ> A" by auto
	have "[set {\<langle>a, 0\<rangle>}, A, set {0}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> set {0}"
	proof(intro smc_Rel_is_arrI)
	show "arr_Rel \<alpha> [set {\<langle>a, 0\<rangle>}, A, set {0}]\<^sub>\<circ>"
	by (intro arr_Rel_vfsequenceI)
	(auto simp: \<open>a \<in>\<^sub>\<circ> A\<close> vsubset_vsingleton_leftI)
	qed (simp_all add: arr_Rel_components)
	moreover have "[0, A, set {0}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> set {0}"
	proof(intro smc_Rel_is_arrI)
	show "arr_Rel \<alpha> [0, A, set {0}]\<^sub>\<circ>"
	by (intro arr_Rel_vfsequenceI)
	(auto simp: \<open>a \<in>\<^sub>\<circ> A\<close> vsubset_vsingleton_leftI)
	qed (simp_all add: arr_Rel_components)
	moreover have "[set {\<langle>a, 0\<rangle>}, A, set {0}]\<^sub>\<circ> \<noteq> [0, A, set {0}]\<^sub>\<circ>" by simp
	ultimately show False
	by (metis prems smc_is_arrE smc_Rel_components(1))
	qed
	next

	fix B assume [simp]: "A = 0" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	proof(rule ex1I[of _ \<open>[0, 0, B]\<^sub>\<circ>\<close>])
	show "[0, 0, B]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (rule is_arrI)
	(
	simp_all add:
	smc_Rel_cs_simps
	smc_Rel_components(2)
	vbrelation_vempty
	arr_Rel_vfsequenceI
	)
	fix T assume "T : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	then have T: "T : 0 \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B" by simp
	interpret T: arr_Rel \<alpha> T
	using T by (fastforce simp: smc_Rel_components(2))
	show "T = [0, 0, B]\<^sub>\<circ>"
	proof
	(
	subst T.arr_Rel_def,
	rule arr_Rel_eqI[of \<alpha>],
	unfold arr_Rel_components
	)
	show "arr_Rel \<alpha> [T\<lparr>ArrVal\<rparr>, T\<lparr>ArrDom\<rparr>, T\<lparr>ArrCod\<rparr>]\<^sub>\<circ>"
	by (fold T.arr_Rel_def) (simp add: T.arr_Rel_axioms)
	- show "arr_Rel \<alpha> [[]\<^sub>\<circ>, []\<^sub>\<circ>, B]\<^sub>\<circ>"
	+ show "arr_Rel \<alpha> [0, 0, B]\<^sub>\<circ>"
	by (simp add: arr_Rel_vfsequenceI vbrelationI)
	from T have "T \<in>\<^sub>\<circ> smc_Rel \<alpha>\<lparr>Arr\<rparr>" by (auto intro: smc_cs_intros)
	with T is_arrD(2,3)[OF T] show "T\<lparr>ArrDom\<rparr> = 0" "T\<lparr>ArrCod\<rparr> = B"
	by (auto simp: smc_Rel_is_arrD(2,3))
	with
	T.arr_Rel_ArrVal_vrange
	T.arr_Rel_ArrVal_vdomain
	T.ArrVal.vbrelation_vintersection_vdomain
	- show "T\<lparr>ArrVal\<rparr> = []\<^sub>\<circ>"
	+ show "T\<lparr>ArrVal\<rparr> = 0"
	by auto
	qed
	qed
	qed

	then show ?thesis
	apply(intro iffI obj_initialI, elim obj_initialE)
	subgoal by (metis smc_Rel_components(1))
	subgoal by (simp add: smc_Rel_components(1))
	subgoal by (metis smc_Rel_components(1))
	done

	qed

	lemma (in \<Z>) smc_Rel_obj_terminal_obj_initial:
	"obj_initial (smc_Rel \<alpha>) A \<longleftrightarrow> obj_terminal (smc_Rel \<alpha>) A"
	unfolding smc_Rel_obj_initial smc_Rel_obj_terminal by simp

	lemma (in \<Z>) smc_Rel_obj_null: "obj_null (smc_Rel \<alpha>) A \<longleftrightarrow> A = 0"
	unfolding obj_null_def smc_Rel_obj_terminal smc_Rel_obj_initial by simp



	subsection\<open>Zero arrow\<close>


	text\<open>
	A zero arrow for \<open>Rel\<close> is any admissible \<open>V\<close>-arrow, such that its value
	is the empty set. A reference for this result is not given, but the
	result is not expected to be original.
	\<close>

	lemma (in \<Z>) smc_Rel_is_zero_arr:
	- assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	+ assumes "A \<in>\<^sub>\<circ> smc_Rel \<alpha>\<lparr>Obj\<rparr>" and "B \<in>\<^sub>\<circ> smc_Rel \<alpha>\<lparr>Obj\<rparr>"
	shows "T : A \<mapsto>\<^sub>0\<^bsub>smc_Rel \<alpha>\<^esub> B \<longleftrightarrow> T = [0, A, B]\<^sub>\<circ>"
	proof(rule HOL.ext iffI)

	interpret Rel: semicategory \<alpha> \<open>smc_Rel \<alpha>\<close> by (rule semicategory_smc_Rel)

	fix T A B assume "T : A \<mapsto>\<^sub>0\<^bsub>smc_Rel \<alpha>\<^esub> B"
	then obtain R S
	where T_def: "T = R \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> S"
	and S: "S : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> 0"
	and R: "R : 0 \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (elim is_zero_arrE) (simp add: obj_null_def smc_Rel_obj_terminal)

	interpret S: arr_Rel \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = A" and [simp]: "S\<lparr>ArrCod\<rparr> = 0"
	- using S by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF S])+
	interpret R: arr_Rel \<alpha> R
	rewrites [simp]: "R\<lparr>ArrDom\<rparr> = 0" and [simp]: "R\<lparr>ArrCod\<rparr> = B"
	- using R by (all\<open>elim Rel.smc_is_arrE\<close>) (simp_all add: smc_Rel_components)
	+ by (intro smc_Rel_is_arrD[OF R])+

	have S_def: "S = [0, A, 0]\<^sub>\<circ>"
	by
	(
	rule arr_Rel_eqI[of \<alpha>],
	unfold arr_Rel_components,
	insert S.arr_Rel_ArrVal_vrange S.ArrVal.vbrelation_vintersection_vrange
	)
	(
	auto simp:
	S.arr_Rel_axioms
	S.arr_Rel_ArrDom_in_Vset
	arr_Rel_vfsequenceI
	vbrelationI
	)
	show "T = [0, A, B]\<^sub>\<circ>"
	unfolding T_def smc_Rel_Comp_app[OF R S]
	by (rule arr_Rel_eqI[of \<alpha>], unfold comp_Rel_components)
	(
	auto simp:
	S_def
	\<Z>_axioms
	R.arr_Rel_axioms
	S.arr_Rel_axioms
	arr_Rel_comp_Rel
	arr_Rel_components
	R.arr_Rel_ArrCod_in_Vset
	S.arr_Rel_ArrDom_in_Vset
	\<Z>.arr_Rel_vfsequenceI
	vbrelation_vempty
	)

	next

	assume prems: "T = [0, A, B]\<^sub>\<circ>"
	let ?S = \<open>[0, A, 0]\<^sub>\<circ>\<close> and ?R = \<open>[0, 0, B]\<^sub>\<circ>\<close>
	have S: "arr_Rel \<alpha> ?S" and R: "arr_Rel \<alpha> ?R"
	- by (all\<open>intro arr_Rel_vfsequenceI\<close>) (auto simp: assms)
	+ by (all\<open>intro arr_Rel_vfsequenceI\<close>)
	+ (auto simp: assms[unfolded smc_Rel_components])
	have SA0: "?S : A \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> 0"
	by (intro smc_Rel_is_arrI) (simp_all add: S arr_Rel_components)
	moreover have R0B: "?R : 0 \<mapsto>\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (intro smc_Rel_is_arrI) (simp_all add: R arr_Rel_components)
	moreover have "T = ?R \<circ>\<^sub>A\<^bsub>smc_Rel \<alpha>\<^esub> ?S"
	unfolding smc_Rel_Comp_app[OF R0B SA0]
	proof(rule arr_Rel_eqI, unfold comp_Rel_components arr_Rel_components prems)
	show "arr_Rel \<alpha> [0, A, B]\<^sub>\<circ>"
	- unfolding prems by (intro arr_Rel_vfsequenceI) (auto simp: assms)
	+ unfolding prems
	+ by (intro arr_Rel_vfsequenceI)
	+ (auto simp: assms[unfolded smc_Rel_components(1)])
	qed (use R S in \<open>auto simp: smc_Rel_cs_intros\<close>)
	ultimately show "T : A \<mapsto>\<^sub>0\<^bsub>smc_Rel \<alpha>\<^esub> B"
	by (simp add: is_zero_arrI smc_Rel_obj_null)

	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semicategory.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semicategory.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semicategory.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semicategory.thy
	@@ -1,1121 +1,1116 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Semicategory\<close>
	theory CZH_SMC_Semicategory
	imports
	CZH_DG_Digraph
	CZH_SMC_Introduction
	begin



	subsection\<open>Background\<close>

	lemmas [smc_cs_simps] = dg_shared_cs_simps
	lemmas [smc_cs_intros] = dg_shared_cs_intros


	subsubsection\<open>Slicing\<close>


	text\<open>
	\<open>Slicing\<close> is a term that is introduced in this work for the description
	of the process of the conversion of more specialized mathematical objects to
	their generalizations.

	The terminology was adapted from the informal imperative
	object oriented programming, where the term slicing often refers to the
	process of copying an object of a subclass type to an object of a
	superclass type \cite{noauthor_wikipedia_2001}\footnote{
	\url{https://en.wikipedia.org/wiki/Object_slicing}
	}.
	However, it is important to note that the term has other meanings in
	programming and computer science.
	\<close>

	definition smc_dg :: "V \<Rightarrow> V"
	where "smc_dg \<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smc_dg_components[slicing_simps]:
	shows "smc_dg \<CC>\<lparr>Obj\<rparr> = \<CC>\<lparr>Obj\<rparr>"
	and "smc_dg \<CC>\<lparr>Arr\<rparr> = \<CC>\<lparr>Arr\<rparr>"
	and "smc_dg \<CC>\<lparr>Dom\<rparr> = \<CC>\<lparr>Dom\<rparr>"
	and "smc_dg \<CC>\<lparr>Cod\<rparr> = \<CC>\<lparr>Cod\<rparr>"
	unfolding smc_dg_def dg_field_simps by (auto simp: nat_omega_simps)


	text\<open>Regular definitions.\<close>

	lemma smc_dg_is_arr[slicing_simps]: "f : a \<mapsto>\<^bsub>smc_dg \<CC>\<^esub> b \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding is_arr_def slicing_simps ..

	lemmas [slicing_intros] = smc_dg_is_arr[THEN iffD2]


	subsubsection\<open>Composition and composable arrows\<close>


	text\<open>
	The definition of a set of \<open>composable_arrs\<close> is equivalent to the definition
	of \<open>composable pairs\<close> presented on page 10 in \cite{mac_lane_categories_2010}
	(see theorem \<open>dg_composable_arrs'\<close> below).
	Nonetheless, the definition is meant to be used sparingly. Normally,
	the arrows are meant to be specified explicitly using the predicate
	\<^const>\<open>is_arr\<close>.
	\<close>

	definition Comp :: V
	where [dg_field_simps]: "Comp = 4\<^sub>\<nat>"

	abbreviation Comp_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>A\<index>" 55)
	where "Comp_app \<CC> a b \<equiv> \<CC>\<lparr>Comp\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	definition composable_arrs :: "V \<Rightarrow> V"
	where "composable_arrs \<CC> = set
	{[g, f]\<^sub>\<circ> \| g f. \<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}"

	lemma small_composable_arrs[simp]:
	"small {[g, f]\<^sub>\<circ> \| g f. \<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}"
	proof(intro down[of _ \<open>\<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>\<close>] subsetI)
	fix x assume "x \<in> {[g, f]\<^sub>\<circ> \| g f. \<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}"
	then obtain g f a b c
	where x_def: "x = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by clarsimp
	with vfsequence_vcpower_two_vpair show "x \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>"
	unfolding x_def by auto
	qed


	text\<open>Rules.\<close>

	lemma composable_arrsI[smc_cs_intros]:
	assumes "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "gf \<in>\<^sub>\<circ> composable_arrs \<CC>"
	using assms(2,3) small_composable_arrs
	unfolding assms(1) composable_arrs_def
	by auto

	lemma composable_arrsE[elim!]:
	assumes "gf \<in>\<^sub>\<circ> composable_arrs \<CC>"
	obtains g f a b c where "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms small_composable_arrs unfolding composable_arrs_def by clarsimp

	lemma small_composable_arrs'[simp]:
	"small {[g, f]\<^sub>\<circ> \| g f. g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>}"
	proof(intro down[of _ \<open>\<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>\<close>] subsetI)
	fix gf assume
	"gf \<in>{[g, f]\<^sub>\<circ> \| g f. g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>}"
	then obtain g f
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "\<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>"
	by clarsimp
	with vfsequence_vcpower_two_vpair show "gf \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>"
	unfolding gf_def by auto
	qed

	lemma dg_composable_arrs':
	"set {[g, f]\<^sub>\<circ> \| g f. g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>} =
	composable_arrs \<CC>"
	proof-
	have "{[g, f]\<^sub>\<circ> \| g f. g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>} =
	{[g, f]\<^sub>\<circ> \| g f. \<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b}"
	proof(intro subset_antisym subsetI, unfold mem_Collect_eq; elim exE conjE)
	fix gf g f
	assume gf_def: "gf = [g, f]\<^sub>\<circ>"
	and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	and gf: "\<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>"
	then obtain a b b' c where g: "g : b' \<mapsto>\<^bsub>\<CC>\<^esub> c" and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by (auto intro!: is_arrI)
	moreover have "b' = b"
	unfolding is_arrD(2,3)[OF g, symmetric] is_arrD(2,3)[OF f, symmetric]
	by (rule gf)
	ultimately have "\<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto
	then show "\<exists>g f. gf = [g, f]\<^sub>\<circ> \<and> (\<exists>a b c. g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	unfolding gf_def by auto
	next
	fix gf g f a b c
	assume gf_def: "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	then have "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" "\<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>" by auto
	then show
	"\<exists>g f. gf = [g, f]\<^sub>\<circ> \<and> g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<CC>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>"
	unfolding gf_def by auto
	qed
	then show ?thesis unfolding composable_arrs_def by auto
	qed



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	The definition of a semicategory that is used in this work is
	similar to the definition that was used in \cite{mitchell_dominion_1972}.
	It is also a natural generalization of the definition of a category that is
	presented in Chapter I-2 in \cite{mac_lane_categories_2010}. The generalization
	is performed by omitting the identity and the axioms associated
	with it. The amendments to the definitions that are associated with size
	have already been explained in the previous chapter.
	\<close>

	locale semicategory = \<Z> \<alpha> + vfsequence \<CC> + Comp: vsv \<open>\<CC>\<lparr>Comp\<rparr>\<close> for \<alpha> \<CC> +
	assumes smc_length[smc_cs_simps]: "vcard \<CC> = 5\<^sub>\<nat>"
	and smc_digraph[slicing_intros]: "digraph \<alpha> (smc_dg \<CC>)"
	and smc_Comp_vdomain: "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and smc_Comp_is_arr:
	"\<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and smc_Comp_assoc[smc_cs_simps]:
	"\<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"

	lemmas [smc_cs_simps] =
	semicategory.smc_length
	semicategory.smc_Comp_assoc

	lemma (in semicategory) smc_Comp_is_arr'[smc_cs_intros]:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<CC>' = \<CC>"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>'\<^esub> c"
	using assms(1,2) unfolding assms(3) by (rule smc_Comp_is_arr)

	lemmas [smc_cs_intros] =
	semicategory.smc_Comp_is_arr'
	semicategory.smc_Comp_is_arr

	lemmas [slicing_intros] = semicategory.smc_digraph


	text\<open>Rules.\<close>

	lemma (in semicategory) semicategory_axioms'[smc_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	shows "semicategory \<alpha>' \<CC>"
	unfolding assms by (rule semicategory_axioms)

	mk_ide rf semicategory_def[unfolded semicategory_axioms_def]
	\|intro semicategoryI\|
	\|dest semicategoryD[dest]\|
	\|elim semicategoryE[elim]\|

	lemma semicategoryI':
	assumes "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vcard \<CC> = 5\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "semicategory \<alpha> \<CC>"
	by (intro semicategoryI digraphI, unfold slicing_simps)
	(simp_all add: assms nat_omega_simps smc_dg_def)

	lemma semicategoryD':
	assumes "semicategory \<alpha> \<CC>"
	shows "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vcard \<CC> = 5\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	simp_all add:
	semicategoryD(2-8)[OF assms]
	digraphD[OF semicategoryD(5)[OF assms], unfolded slicing_simps]
	)

	lemma semicategoryE':
	assumes "semicategory \<alpha> \<CC>"
	obtains "\<Z> \<alpha>"
	and "vfsequence \<CC>"
	and "vsv (\<CC>\<lparr>Comp\<rparr>)"
	and "vcard \<CC> = 5\<^sub>\<nat>"
	and "vsv (\<CC>\<lparr>Dom\<rparr>)"
	and "vsv (\<CC>\<lparr>Cod\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
	and "\<R>\<^sub>\<circ> (\<CC>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>gf. gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b)"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow> g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "\<And>c d h b g a f. \<lbrakk> h : c \<mapsto>\<^bsub>\<CC>\<^esub> d; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	(h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp add: semicategoryD')


	text\<open>
	While using the sublocale infrastructure in conjunction with the rewrite
	morphisms is plausible for achieving automation of slicing, this approach
	has certain limitations. For example, the rewrite morphisms cannot be added to a
	given interpretation that was achieved using the
	command @{command sublocale}\footnote{
	\url{
	https://lists.cam.ac.uk/pipermail/cl-isabelle-users/2019-September/msg00074.html
	}
	}.
	Thus, instead of using a partial solution based on the command
	@{command sublocale}, the rewriting is performed manually for
	selected theorems. However, it is hoped that better automation will be provided
	in the future.
	\<close>

	context semicategory
	begin

	interpretation dg: digraph \<alpha> \<open>smc_dg \<CC>\<close> by (rule smc_digraph)

	sublocale Dom: vsv \<open>\<CC>\<lparr>Dom\<rparr>\<close> by (rule dg.Dom.vsv_axioms[unfolded slicing_simps])
	sublocale Cod: vsv \<open>\<CC>\<lparr>Cod\<rparr>\<close> by (rule dg.Cod.vsv_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	smc_Dom_vdomain[smc_cs_simps] = dg.dg_Dom_vdomain
	and smc_Dom_vrange = dg.dg_Dom_vrange
	and smc_Cod_vdomain[smc_cs_simps] = dg.dg_Cod_vdomain
	and smc_Cod_vrange = dg.dg_Cod_vrange
	and smc_Obj_vsubset_Vset = dg.dg_Obj_vsubset_Vset
	and smc_Hom_vifunion_in_Vset[smc_cs_intros] = dg.dg_Hom_vifunion_in_Vset
	and smc_Obj_if_Dom_vrange = dg.dg_Obj_if_Dom_vrange
	and smc_Obj_if_Cod_vrange = dg.dg_Obj_if_Cod_vrange
	and smc_is_arrD = dg.dg_is_arrD
	and smc_is_arrE[elim] = dg.dg_is_arrE
	and smc_in_ArrE[elim] = dg.dg_in_ArrE
	and smc_Hom_in_Vset[smc_cs_intros] = dg.dg_Hom_in_Vset
	and smc_Arr_vsubset_Vset = dg.dg_Arr_vsubset_Vset
	and smc_Dom_vsubset_Vset = dg.dg_Dom_vsubset_Vset
	and smc_Cod_vsubset_Vset = dg.dg_Cod_vsubset_Vset
	and smc_Obj_in_Vset = dg.dg_Obj_in_Vset
	and smc_in_Obj_in_Vset[smc_cs_intros] = dg.dg_in_Obj_in_Vset
	and smc_Arr_in_Vset = dg.dg_Arr_in_Vset
	and smc_in_Arr_in_Vset[smc_cs_intros] = dg.dg_in_Arr_in_Vset
	and smc_Dom_in_Vset = dg.dg_Dom_in_Vset
	and smc_Cod_in_Vset = dg.dg_Cod_in_Vset
	and smc_digraph_if_ge_Limit = dg.dg_digraph_if_ge_Limit
	and smc_Dom_app_in_Obj = dg.dg_Dom_app_in_Obj
	and smc_Cod_app_in_Obj = dg.dg_Cod_app_in_Obj
	and smc_Arr_vempty_if_Obj_vempty = dg.dg_Arr_vempty_if_Obj_vempty
	and smc_Dom_vempty_if_Arr_vempty = dg.dg_Dom_vempty_if_Arr_vempty
	and smc_Cod_vempty_if_Arr_vempty = dg.dg_Cod_vempty_if_Arr_vempty

	end

	lemmas [smc_cs_intros] =
	semicategory.smc_is_arrD(1-3)
	semicategory.smc_Hom_in_Vset


	text\<open>Elementary properties.\<close>

	lemma smc_eqI:
	assumes "semicategory \<alpha> \<AA>"
	and "semicategory \<alpha> \<BB>"
	and "\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	and "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	and "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	and "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	and "\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	shows "\<AA> = \<BB>"
	proof-
	interpret \<AA>: semicategory \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: semicategory \<alpha> \<BB> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<AA> = 5\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>"
	by (cs_concl cs_shallow cs_simp: dom smc_cs_simps V_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<AA> \<Longrightarrow> \<AA>\<lparr>a\<rparr> = \<BB>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms) (auto simp: dg_field_simps)
	qed auto
	qed

	lemma smc_dg_eqI:
	assumes "semicategory \<alpha> \<AA>"
	and "semicategory \<alpha> \<BB>"
	and "\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	and "smc_dg \<AA> = smc_dg \<BB>"
	shows "\<AA> = \<BB>"
	proof(rule smc_eqI)
	from assms(4) have
	"smc_dg \<AA>\<lparr>Obj\<rparr> = smc_dg \<BB>\<lparr>Obj\<rparr>"
	"smc_dg \<AA>\<lparr>Arr\<rparr> = smc_dg \<BB>\<lparr>Arr\<rparr>"
	"smc_dg \<AA>\<lparr>Dom\<rparr> = smc_dg \<BB>\<lparr>Dom\<rparr>"
	"smc_dg \<AA>\<lparr>Cod\<rparr> = smc_dg \<BB>\<lparr>Cod\<rparr>"
	by auto
	then show
	"\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>" "\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>" "\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>" "\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	unfolding slicing_simps by simp_all
	qed (auto intro: assms)

	lemma (in semicategory) smc_def: "\<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<CC> = 5\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps V_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>]\<^sub>\<circ> = 5\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<CC> = \<D>\<^sub>\<circ> [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<CC> \<Longrightarrow> \<CC>\<lparr>a\<rparr> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Dom\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Comp\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	unfolding dom_lhs
	by elim_in_numeral (simp_all add: dg_field_simps nat_omega_simps)
	qed auto

	lemma (in semicategory) smc_Comp_vdomainI[smc_cs_intros]:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "gf = [g, f]\<^sub>\<circ>"
	shows "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	using assms by (intro smc_Comp_vdomain[THEN iffD2]) auto

	lemmas [smc_cs_intros] = semicategory.smc_Comp_vdomainI

	lemma (in semicategory) smc_Comp_vdomainE[elim!]:
	assumes "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	obtains g f a b c where "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	proof-
	from smc_Comp_vdomain[THEN iffD1, OF assms(1)] obtain g f b c a
	where "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by clarsimp
	with that show ?thesis by simp
	qed

	lemma (in semicategory) smc_Comp_vdomain_is_composable_arrs:
	"\<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) = composable_arrs \<CC>"
	by (intro vsubset_antisym vsubsetI) (auto intro!: smc_cs_intros)+

	lemma (in semicategory) smc_Comp_vrange: "\<R>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof(rule Comp.vsv_vrange_vsubset)
	fix gf assume "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	from smc_Comp_vdomain[THEN iffD1, OF this] obtain g f b c a
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by clarsimp
	from semicategory_axioms g f show "\<CC>\<lparr>Comp\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: gf_def smc_cs_simps cs_intro: smc_cs_intros
	)
	qed

	sublocale semicategory \<subseteq> Comp: pbinop \<open>\<CC>\<lparr>Arr\<rparr>\<close> \<open>\<CC>\<lparr>Comp\<rparr>\<close>
	proof unfold_locales
	show "\<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>"
	proof(intro vsubsetI; unfold smc_Comp_vdomain)
	fix gf assume "\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	then obtain a b c g f
	where x_def: "gf = [g, f]\<^sub>\<circ>" and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by auto
	then have "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by auto
	then show "gf \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> ^\<^sub>\<times> 2\<^sub>\<nat>"
	unfolding x_def by (auto simp: nat_omega_simps)
	qed
	show "\<R>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by (rule smc_Comp_vrange)
	qed auto


	text\<open>Size.\<close>

	lemma (in semicategory) smc_Comp_vsubset_Vset: "\<CC>\<lparr>Comp\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix gfh assume "gfh \<in>\<^sub>\<circ> \<CC>\<lparr>Comp\<rparr>"
	then obtain gf h
	where gfh_def: "gfh = \<langle>gf, h\<rangle>"
	and gf: "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	and h: "h \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	by (blast elim: Comp.vbrelation_vinE)
	from gf obtain g f a b c
	where gf_def: "gf = [g, f]\<^sub>\<circ>" and g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by clarsimp
	from h smc_Comp_vrange have "h \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by auto
	with g f show "gfh \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding gfh_def gf_def
	by (cs_concl cs_shallow cs_intro: smc_cs_intros V_cs_intros)
	qed

	lemma (in semicategory) smc_semicategory_in_Vset_4: "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], smc_cs_intros] =
	smc_Obj_vsubset_Vset
	smc_Arr_vsubset_Vset
	smc_Dom_vsubset_Vset
	smc_Cod_vsubset_Vset
	smc_Comp_vsubset_Vset
	show ?thesis
	by (subst smc_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps
	cs_intro: smc_cs_intros V_cs_intros
	)
	qed

	lemma (in semicategory) smc_Comp_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC>\<lparr>Comp\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	using smc_Comp_vsubset_Vset by (meson Vset_in_mono assms(2) vsubset_in_VsetI)

	lemma (in semicategory) smc_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<CC> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [smc_cs_intros] =
	smc_Obj_in_Vset
	smc_Arr_in_Vset
	smc_Dom_in_Vset
	smc_Cod_in_Vset
	smc_Comp_in_Vset
	from assms(2) show ?thesis
	by (subst smc_def) (cs_concl cs_shallow cs_intro: smc_cs_intros V_cs_intros)
	qed

	lemma (in semicategory) smc_semicategory_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "semicategory \<beta> \<CC>"
	by (rule semicategoryI)
	(
	auto
	intro: smc_cs_intros
	simp: smc_cs_simps assms vfsequence_axioms smc_digraph_if_ge_Limit
	)

	lemma small_semicategory[simp]: "small {\<CC>. semicategory \<alpha> \<CC>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from semicategory.smc_in_Vset[of \<alpha>] show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<CC>. semicategory \<alpha> \<CC>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in \<Z>) semicategories_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "set {\<CC>. semicategory \<alpha> \<CC>} \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "set {\<CC>. semicategory \<alpha> \<CC>} \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<CC> assume prems: "\<CC> \<in>\<^sub>\<circ> set {\<CC>. semicategory \<alpha> \<CC>}"
	interpret semicategory \<alpha> \<CC> using prems by simp
	show "\<CC> \<in>\<^sub>\<circ> Vset (\<alpha> + 4\<^sub>\<nat>)"
	unfolding VPow_iff by (rule smc_semicategory_in_Vset_4)
	qed
	from assms(2) show "Vset (\<alpha> + 4\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma semicategory_if_semicategory:
	assumes "semicategory \<beta> \<CC>"
	and "\<Z> \<alpha>"
	and "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>A B. \<lbrakk> A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; B \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; A \<in>\<^sub>\<circ> Vset \<alpha>; B \<in>\<^sub>\<circ> Vset \<alpha> \<rbrakk> \<Longrightarrow>
	(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "semicategory \<alpha> \<CC>"
	proof-
	interpret semicategory \<beta> \<CC> by (rule assms(1))
	interpret \<alpha>: \<Z> \<alpha> by (rule assms(2))
	show ?thesis
	proof(intro semicategoryI)
	show "vfsequence \<CC>" by (simp add: vfsequence_axioms)
	show "digraph \<alpha> (smc_dg \<CC>)"
	by (rule digraph_if_digraph, unfold slicing_simps)
	(auto intro!: assms(1,3,4) slicing_intros)
	qed (auto intro: smc_cs_intros simp: smc_cs_simps)
	qed


	-text\<open>Further elementary properties.\<close>
	+text\<open>Further properties.\<close>

	lemma (in semicategory) smc_Comp_vempty_if_Arr_vempty:
	assumes "\<CC>\<lparr>Arr\<rparr> = 0"
	shows "\<CC>\<lparr>Comp\<rparr> = 0"
	using assms smc_Comp_vrange by (auto intro: Comp.vsv_vrange_vempty)



	subsection\<open>Opposite semicategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_smc :: "V \<Rightarrow> V"
	where "op_smc \<CC> = [\<CC>\<lparr>Obj\<rparr>, \<CC>\<lparr>Arr\<rparr>, \<CC>\<lparr>Cod\<rparr>, \<CC>\<lparr>Dom\<rparr>, fflip (\<CC>\<lparr>Comp\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_smc_components:
	shows [smc_op_simps]: "op_smc \<CC>\<lparr>Obj\<rparr> = \<CC>\<lparr>Obj\<rparr>"
	and [smc_op_simps]: "op_smc \<CC>\<lparr>Arr\<rparr> = \<CC>\<lparr>Arr\<rparr>"
	and [smc_op_simps]: "op_smc \<CC>\<lparr>Dom\<rparr> = \<CC>\<lparr>Cod\<rparr>"
	and [smc_op_simps]: "op_smc \<CC>\<lparr>Cod\<rparr> = \<CC>\<lparr>Dom\<rparr>"
	and "op_smc \<CC>\<lparr>Comp\<rparr> = fflip (\<CC>\<lparr>Comp\<rparr>)"
	unfolding op_smc_def dg_field_simps by (auto simp: nat_omega_simps)

	lemma op_smc_component_intros[smc_op_intros]:
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> a \<in>\<^sub>\<circ> op_smc \<CC>\<lparr>Obj\<rparr>"
	and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<Longrightarrow> f \<in>\<^sub>\<circ> op_smc \<CC>\<lparr>Arr\<rparr>"
	unfolding smc_op_simps by simp_all


	text\<open>Slicing.\<close>

	lemma op_dg_smc_dg[slicing_commute]: "op_dg (smc_dg \<CC>) = smc_dg (op_smc \<CC>)"
	unfolding smc_dg_def op_smc_def op_dg_def dg_field_simps
	by (simp add: nat_omega_simps)


	text\<open>Regular definitions.\<close>

	lemma op_smc_Comp_vdomain[smc_op_simps]:
	"\<D>\<^sub>\<circ> (op_smc \<CC>\<lparr>Comp\<rparr>) = (\<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>))\<inverse>\<^sub>\<bullet>"
	unfolding op_smc_components by simp

	lemma op_smc_is_arr[smc_op_simps]: "f : b \<mapsto>\<^bsub>op_smc \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding smc_op_simps is_arr_def by auto

	lemmas [smc_op_intros] = op_smc_is_arr[THEN iffD2]

	lemma (in semicategory) op_smc_Comp_vrange[smc_op_simps]:
	"\<R>\<^sub>\<circ> (op_smc \<CC>\<lparr>Comp\<rparr>) = \<R>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	using Comp.vrange_fflip unfolding op_smc_components by simp

	lemmas [smc_op_simps] = semicategory.op_smc_Comp_vrange

	lemma (in semicategory) op_smc_Comp[smc_op_simps]:
	assumes "f : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "g \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	using assms
	unfolding op_smc_components
	by (auto intro!: fflip_app smc_cs_intros)

	lemmas [smc_op_simps] = semicategory.op_smc_Comp

	lemma op_smc_Hom[smc_op_simps]: "Hom (op_smc \<CC>) a b = Hom \<CC> b a"
	unfolding smc_op_simps by simp


	subsubsection\<open>Further properties\<close>

	lemma (in semicategory) semicategory_op[smc_op_intros]:
	"semicategory \<alpha> (op_smc \<CC>)"
	proof(intro semicategoryI)
	from semicategory_axioms smc_digraph show "digraph \<alpha> (smc_dg (op_smc \<CC>))"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric] cs_intro: dg_op_intros
	)
	show "vfsequence (op_smc \<CC>)" unfolding op_smc_def by simp
	show "vcard (op_smc \<CC>) = 5\<^sub>\<nat>"
	unfolding op_smc_def by (simp add: nat_omega_simps)
	show "(gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_smc \<CC>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>op_smc \<CC>\<^esub> c \<and> f : a \<mapsto>\<^bsub>op_smc \<CC>\<^esub> b)"
	for gf
	proof(rule iffI; unfold smc_op_simps)
	assume prems: "gf \<in>\<^sub>\<circ> (\<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>))\<inverse>\<^sub>\<bullet>"
	then obtain g' f' where gf_def: "gf = [g', f']\<^sub>\<circ>" by clarsimp
	with prems have "[f', g']\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)" by (auto intro: smc_cs_intros)
	with smc_Comp_vdomain show
	"\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : c \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	unfolding gf_def by auto
	next
	assume "\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : c \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	then obtain g f b c a
	where gf_def: "gf = [g, f]\<^sub>\<circ>" and g: "g : c \<mapsto>\<^bsub>\<CC>\<^esub> b" and f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by clarsimp
	then have "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by force+
	from g f have "[f, g]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>)"
	unfolding gf_def by (intro smc_Comp_vdomainI) auto
	then show "gf \<in>\<^sub>\<circ> (\<D>\<^sub>\<circ> (\<CC>\<lparr>Comp\<rparr>))\<inverse>\<^sub>\<bullet>"
	unfolding gf_def by (auto intro: smc_cs_intros)
	qed
	from semicategory_axioms show
	"\<lbrakk> g : b \<mapsto>\<^bsub>op_smc \<CC>\<^esub> c; f : a \<mapsto>\<^bsub>op_smc \<CC>\<^esub> b \<rbrakk> \<Longrightarrow>
	g \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f : a \<mapsto>\<^bsub>op_smc \<CC>\<^esub> c"
	for g b c f a
	unfolding smc_op_simps
	by (cs_concl cs_shallow cs_simp: smc_op_simps cs_intro: smc_cs_intros)
	fix h c d g b f a
	assume "h : c \<mapsto>\<^bsub>op_smc \<CC>\<^esub> d" "g : b \<mapsto>\<^bsub>op_smc \<CC>\<^esub> c" "f : a \<mapsto>\<^bsub>op_smc \<CC>\<^esub> b"
	with semicategory_axioms show
	"(h \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f = h \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f)"
	unfolding smc_op_simps
	by (cs_concl cs_simp: smc_op_simps smc_cs_simps cs_intro: smc_cs_intros)
	qed (auto simp: fflip_vsv op_smc_components(5))

	lemmas semicategory_op[smc_op_intros] = semicategory.semicategory_op

	lemma (in semicategory) smc_op_smc_op_smc[smc_op_simps]: "op_smc (op_smc \<CC>) = \<CC>"
	by (rule smc_eqI, unfold smc_op_simps op_smc_components)
	(
	auto simp:
	Comp.pbinop_fflip_fflip
	semicategory_axioms
	semicategory.semicategory_op semicategory_op
	intro: smc_cs_intros
	)

	lemmas smc_op_smc_op_smc[smc_op_simps] = semicategory.smc_op_smc_op_smc

	lemma eq_op_smc_iff[smc_op_simps]:
	assumes "semicategory \<alpha> \<AA>" and "semicategory \<alpha> \<BB>"
	shows "op_smc \<AA> = op_smc \<BB> \<longleftrightarrow> \<AA> = \<BB>"
	proof
	interpret \<AA>: semicategory \<alpha> \<AA> by (rule assms(1))
	interpret \<BB>: semicategory \<alpha> \<BB> by (rule assms(2))
	assume prems: "op_smc \<AA> = op_smc \<BB>" show "\<AA> = \<BB>"
	proof(rule smc_eqI)
	show
	"\<AA>\<lparr>Obj\<rparr> = \<BB>\<lparr>Obj\<rparr>"
	"\<AA>\<lparr>Arr\<rparr> = \<BB>\<lparr>Arr\<rparr>"
	"\<AA>\<lparr>Dom\<rparr> = \<BB>\<lparr>Dom\<rparr>"
	"\<AA>\<lparr>Cod\<rparr> = \<BB>\<lparr>Cod\<rparr>"
	"\<AA>\<lparr>Comp\<rparr> = \<BB>\<lparr>Comp\<rparr>"
	by (metis prems \<AA>.smc_op_smc_op_smc \<BB>.smc_op_smc_op_smc)+
	qed (auto intro: assms)
	qed auto



	subsection\<open>Arrow with a domain and a codomain\<close>

	lemma (in semicategory) smc_assoc_helper:
	assumes "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "h : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
	- and "q : b \<mapsto>\<^bsub>\<CC>\<^esub> d"
	and "h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = q"
	shows "h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	using semicategory_axioms assms(1-4)
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: semicategory.smc_Comp_assoc[symmetric] assms(5)
	- )
	+ by (cs_concl cs_simp: assms(4) semicategory.smc_Comp_assoc[symmetric])

	lemma (in semicategory) smc_pattern_rectangle_right:
	assumes "aa' : a \<mapsto>\<^bsub>\<CC>\<^esub> a'"
	and "a'a'' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a''"
	and "a''b'' : a'' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
	and "ab : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "bb' : b \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	and "b'b'' : b' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
	and "a'b' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
	and "a'b' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa' = bb' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ab"
	and "b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> a'b' = a''b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> a'a''"
	shows "a''b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (a'a'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa') = (b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bb') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ab"
	proof-
	from semicategory_axioms assms(3,2,1) have
	"a''b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (a'a'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa') = (a''b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> a'a'') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa'"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps cs_intro: smc_cs_intros)
	also have "\<dots> = (b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> a'b') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa'" unfolding assms(9) ..
	also from semicategory_axioms assms(1,6,7) have
	"\<dots> = b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (a'b' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> aa')"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps cs_intro: smc_cs_intros)
	also have "\<dots> = b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (bb' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ab)" unfolding assms(8) ..
	also from semicategory_axioms assms(6,5,4) have
	"\<dots> = (b'b'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bb') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ab"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps cs_intro: smc_cs_intros)
	finally show ?thesis by simp
	qed

	lemmas (in semicategory) smc_pattern_rectangle_left =
	smc_pattern_rectangle_right[symmetric]



	subsection\<open>Monic arrow and epic arrow\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition is_monic_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_monic_arr \<CC> b c m \<longleftrightarrow>
	m : b \<mapsto>\<^bsub>\<CC>\<^esub> c \<and>
	(
	\<forall>f g a.
	f : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<longrightarrow> g : a \<mapsto>\<^bsub>\<CC>\<^esub> b \<longrightarrow> m \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = m \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g \<longrightarrow> f = g
	)"

	syntax "_is_monic_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>_ : _ \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<index> _\<close> [51, 51, 51] 51)
	translations "m : b \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> c" \<rightleftharpoons> "CONST is_monic_arr \<CC> b c m"

	definition is_epic_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_epic_arr \<CC> a b e \<equiv> e : b \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>op_smc \<CC>\<^esub> a"

	syntax "_is_epic_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>_ : _ \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<index> _\<close> [51, 51, 51] 51)
	translations "e : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_epic_arr \<CC> a b e"


	text\<open>Rules.\<close>

	mk_ide rf is_monic_arr_def
	\|intro is_monic_arrI\|
	\|dest is_monic_arrD[dest]\|
	\|elim is_monic_arrE[elim!]\|

	lemmas [smc_arrow_cs_intros] = is_monic_arrD(1)

	lemma (in semicategory) is_epic_arrI:
	assumes "e : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<And>f g c. \<lbrakk> f : b \<mapsto>\<^bsub>\<CC>\<^esub> c; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<rbrakk> \<Longrightarrow>
	f = g"
	shows "e : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	unfolding is_epic_arr_def
	proof(intro is_monic_arrI, unfold smc_op_simps)
	fix f g a
	assume prems:
	"f : b \<mapsto>\<^bsub>\<CC>\<^esub> a" "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a" "e \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f = e \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> g"
	show "f = g"
	proof-
	from prems(3,1,2) assms(1) semicategory_axioms have "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e"
	by
	(
	cs_prems cs_shallow
	cs_simp: smc_cs_simps smc_op_simps
	cs_intro: smc_cs_intros smc_op_intros
	)
	simp
	from assms(2)[OF prems(2,1) this] show ?thesis ..
	qed
	qed (rule assms(1))

	lemma is_epic_arr_is_arr[smc_arrow_cs_intros, dest]:
	assumes "e : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	shows "e : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms unfolding is_epic_arr_def is_monic_arr_def smc_op_simps by simp

	lemma (in semicategory) is_epic_arrD[dest]:
	assumes "e : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	shows "e : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<And>f g c. \<lbrakk> f : b \<mapsto>\<^bsub>\<CC>\<^esub> c; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<rbrakk> \<Longrightarrow>
	f = g"
	proof-
	note is_monic_arrD =
	assms(1)[unfolded is_epic_arr_def is_monic_arr_def smc_op_simps]
	from is_monic_arrD[THEN conjunct1] show e: "e : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by simp
	fix f g c
	assume prems: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e"
	with semicategory_axioms e have "e \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f = e \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> g"
	by (cs_concl cs_shallow cs_simp: smc_op_simps cs_intro: smc_cs_intros)
	then show "f = g"
	by (rule is_monic_arrD[THEN conjunct2, rule_format, OF prems(1,2)])
	qed

	lemma (in semicategory) is_epic_arrE[elim!]:
	assumes "e : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	obtains "e : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "\<And>f g c. \<lbrakk> f : b \<mapsto>\<^bsub>\<CC>\<^esub> c; g : b \<mapsto>\<^bsub>\<CC>\<^esub> c; f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<rbrakk> \<Longrightarrow>
	f = g"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in semicategory) op_smc_is_epic_arr[smc_op_simps]:
	"f : b \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>op_smc \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b"
	unfolding is_monic_arr_def is_epic_arr_def smc_op_simps ..

	lemma (in semicategory) op_smc_is_monic_arr[smc_op_simps]:
	"f : b \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>op_smc \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	unfolding is_monic_arr_def is_epic_arr_def smc_op_simps ..

	lemma (in semicategory) smc_Comp_is_monic_arr[smc_arrow_cs_intros]:
	assumes "g : b \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> c"
	proof(intro is_monic_arrI)
	from assms show "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c" by (auto intro: smc_cs_intros)
	fix f' g' a'
	assume f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and g': "g' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	with assms have "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g')"
	by (force simp: smc_Comp_assoc)
	moreover from assms have "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b" "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by (auto intro: f' g' smc_cs_intros)
	ultimately have "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'" using assms(1) by clarsimp
	with assms f' g' show "f' = g'" by clarsimp
	qed

	lemmas [smc_arrow_cs_intros] = semicategory.smc_Comp_is_monic_arr

	lemma (in semicategory) smc_Comp_is_epic_arr[smc_arrow_cs_intros]:
	assumes "g : b \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> b"
	shows "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> c"
	proof-
	from assms op_smc_is_arr have "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	unfolding is_epic_arr_def by auto
	with semicategory_axioms have "f \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> g = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (cs_concl cs_shallow cs_simp: smc_op_simps)
	with
	semicategory.smc_Comp_is_monic_arr[
	OF semicategory_op,
	OF assms(2,1)[unfolded is_epic_arr_def],
	folded is_epic_arr_def
	]
	show ?thesis
	by auto
	qed

	lemmas [smc_arrow_cs_intros] = semicategory.smc_Comp_is_epic_arr

	lemma (in semicategory) smc_Comp_is_monic_arr_is_monic_arr:
	assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> c"
	shows "f : a \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> b"
	proof(intro is_monic_arrI)
	fix f' g' a'
	assume f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and g': "g' : a' \<mapsto>\<^bsub>\<CC>\<^esub> a"
	and f'gg'g: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	from assms(1,2) f' g' have "(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	by (auto simp: smc_Comp_assoc f'gg'g)
	with assms(3) f' g' show "f' = g'" by clarsimp
	qed (simp add: assms(2))

	lemma (in semicategory) smc_Comp_is_epic_arr_is_epic_arr:
	assumes "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "f : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> c"
	shows "f : b \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> c"
	proof-
	from assms have "g : b \<mapsto>\<^bsub>op_smc \<CC>\<^esub> a" "f : c \<mapsto>\<^bsub>op_smc \<CC>\<^esub> b"
	unfolding smc_op_simps by simp_all
	moreover from semicategory_axioms assms have "g \<circ>\<^sub>A\<^bsub>op_smc \<CC>\<^esub> f : a \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_simp: smc_op_simps)
	ultimately show ?thesis
	using
	semicategory.smc_Comp_is_monic_arr_is_monic_arr[
	OF semicategory_op, folded is_epic_arr_def
	]
	by auto
	qed



	subsection\<open>Idempotent arrow\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition is_idem_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_idem_arr \<CC> b f \<longleftrightarrow> f : b \<mapsto>\<^bsub>\<CC>\<^esub> b \<and> f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"

	syntax "_is_idem_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool" (\<open>_ : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<index> _\<close> [51, 51] 51)
	translations "f : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_idem_arr \<CC> b f"


	text\<open>Rules.\<close>

	mk_ide rf is_idem_arr_def
	\|intro is_idem_arrI\|
	\|dest is_idem_arrD[dest]\|
	\|elim is_idem_arrE[elim!]\|

	lemmas [smc_cs_simps] = is_idem_arrD(2)


	text\<open>Elementary properties.\<close>

	lemma (in semicategory) op_smc_is_idem_arr[smc_op_simps]:
	"f : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<^bsub>op_smc \<CC>\<^esub> b \<longleftrightarrow> f : \<mapsto>\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<CC>\<^esub> b"
	using op_smc_Comp unfolding is_idem_arr_def smc_op_simps by auto



	subsection\<open>Terminal object and initial object\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition obj_terminal :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "obj_terminal \<CC> t \<longleftrightarrow>
	t \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<and> (\<forall>a. a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<longrightarrow> (\<exists>!f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> t))"

	definition obj_initial :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "obj_initial \<CC> \<equiv> obj_terminal (op_smc \<CC>)"


	text\<open>Rules.\<close>

	mk_ide rf obj_terminal_def
	\|intro obj_terminalI\|
	\|dest obj_terminalD[dest]\|
	\|elim obj_terminalE[elim]\|

	lemma obj_initialI:
	assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>b. b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>!f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "obj_initial \<CC> a"
	unfolding obj_initial_def
	by (simp add: obj_terminalI[of _ \<open>op_smc \<CC>\<close>, unfolded smc_op_simps, OF assms])

	lemma obj_initialD[dest]:
	assumes "obj_initial \<CC> a"
	shows "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>b. b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>!f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by
	(
	simp_all add:
	obj_terminalD[OF assms[unfolded obj_initial_def], unfolded smc_op_simps]
	)

	lemma obj_initialE[elim]:
	assumes "obj_initial \<CC> a"
	obtains "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>b. b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>!f. f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms by (auto simp: obj_initialD)


	text\<open>Elementary properties.\<close>

	lemma op_smc_obj_initial[smc_op_simps]:
	"obj_initial (op_smc \<CC>) = obj_terminal \<CC>"
	unfolding obj_initial_def obj_terminal_def smc_op_simps ..

	lemma op_smc_obj_terminal[smc_op_simps]:
	"obj_terminal (op_smc \<CC>) = obj_initial \<CC>"
	unfolding obj_initial_def obj_terminal_def smc_op_simps ..



	subsection\<open>Null object\<close>


	text\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}.\<close>

	definition obj_null :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "obj_null \<CC> a \<longleftrightarrow> obj_initial \<CC> a \<and> obj_terminal \<CC> a"


	text\<open>Rules.\<close>

	mk_ide rf obj_null_def
	\|intro obj_nullI\|
	\|dest obj_nullD[dest]\|
	\|elim obj_nullE[elim]\|


	text\<open>Elementary properties.\<close>

	lemma op_smc_obj_null[smc_op_simps]: "obj_null (op_smc \<CC>) a = obj_null \<CC> a"
	unfolding obj_null_def smc_op_simps by auto



	subsection\<open>Zero arrow\<close>

	definition is_zero_arr :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_zero_arr \<CC> a b h \<longleftrightarrow>
	(\<exists>z g f. obj_null \<CC> z \<and> h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> z \<and> g : z \<mapsto>\<^bsub>\<CC>\<^esub> b)"

	syntax "_is_zero_arr" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>_ : _ \<mapsto>\<^sub>0\<index> _\<close> [51, 51, 51] 51)
	translations "h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b" \<rightleftharpoons> "CONST is_zero_arr \<CC> a b h"


	text\<open>Rules.\<close>

	lemma is_zero_arrI:
	assumes "obj_null \<CC> z"
	and "h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	and "g : z \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	using assms unfolding is_zero_arr_def by auto

	lemma is_zero_arrD[dest]:
	assumes "h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	shows "\<exists>z g f. obj_null \<CC> z \<and> h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> z \<and> g : z \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms unfolding is_zero_arr_def by simp

	lemma is_zero_arrE[elim]:
	assumes "h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	obtains z g f
	where "obj_null \<CC> z"
	and "h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	and "g : z \<mapsto>\<^bsub>\<CC>\<^esub> b"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in semicategory) op_smc_is_zero_arr[smc_op_simps]:
	"f : b \<mapsto>\<^sub>0\<^bsub>op_smc \<CC>\<^esub> a \<longleftrightarrow> f : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	using op_smc_Comp unfolding is_zero_arr_def smc_op_simps by metis

	lemma (in semicategory) smc_is_zero_arr_Comp_right:
	assumes "h : b \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> c" and "h' : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	shows "h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> c"
	proof-
	from assms(1) obtain z g f
	where "obj_null \<CC> z"
	and "h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	and "f : b \<mapsto>\<^bsub>\<CC>\<^esub> z"
	and "g : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by auto
	with assms show ?thesis
	by (auto simp: smc_cs_simps intro: is_zero_arrI smc_cs_intros)
	qed

	lemmas [smc_arrow_cs_intros] = semicategory.smc_is_zero_arr_Comp_right

	lemma (in semicategory) smc_is_zero_arr_Comp_left:
	assumes "h' : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> b"
	shows "h' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h : a \<mapsto>\<^sub>0\<^bsub>\<CC>\<^esub> c"
	proof-
	from assms(2) obtain z g f
	where "obj_null \<CC> z"
	and "h = g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	and "g : z \<mapsto>\<^bsub>\<CC>\<^esub> b"
	by auto
	with assms(1) show ?thesis
	by (intro is_zero_arrI[of _ _ _ \<open>h' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g\<close>])
	(auto simp: smc_Comp_assoc intro: is_zero_arrI smc_cs_intros)
	qed

	lemmas [smc_arrow_cs_intros] = semicategory.smc_is_zero_arr_Comp_left

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
	@@ -1,2136 +1,2157 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Semifunctor\<close>
	theory CZH_SMC_Semifunctor
	imports
	CZH_DG_DGHM
	CZH_SMC_Semicategory
	begin



	subsection\<open>Background\<close>

	named_theorems smcf_cs_simps
	named_theorems smcf_cs_intros

	named_theorems smc_cn_cs_simps
	named_theorems smc_cn_cs_intros

	lemmas [smc_cs_simps] = dg_shared_cs_simps
	lemmas [smc_cs_intros] = dg_shared_cs_intros


	subsubsection\<open>Slicing\<close>

	definition smcf_dghm :: "V \<Rightarrow> V"
	where "smcf_dghm \<CC> =
	[\<CC>\<lparr>ObjMap\<rparr>, \<CC>\<lparr>ArrMap\<rparr>, smc_dg (\<CC>\<lparr>HomDom\<rparr>), smc_dg (\<CC>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smcf_dghm_components:
	shows [slicing_simps]: "smcf_dghm \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and [slicing_simps]: "smcf_dghm \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and [slicing_commute]: "smcf_dghm \<FF>\<lparr>HomDom\<rparr> = smc_dg (\<FF>\<lparr>HomDom\<rparr>)"
	and [slicing_commute]: "smcf_dghm \<FF>\<lparr>HomCod\<rparr> = smc_dg (\<FF>\<lparr>HomCod\<rparr>)"
	unfolding smcf_dghm_def dghm_field_simps by (auto simp: nat_omega_simps)



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	See Chapter I-3 in \cite{mac_lane_categories_2010} and the description
	of the concept of a digraph homomorphism in the previous chapter.
	\<close>

	locale is_semifunctor =
	\<Z> \<alpha> +
	vfsequence \<FF> +
	HomDom: semicategory \<alpha> \<AA> +
	HomCod: semicategory \<alpha> \<BB>
	for \<alpha> \<AA> \<BB> \<FF> +
	assumes smcf_length[smc_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>"
	and smcf_is_dghm[slicing_intros]:
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
	and smcf_HomDom[smc_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and smcf_HomCod[smc_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and smcf_ArrMap_Comp[smc_cs_simps]: "\<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"

	syntax "_is_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_semifunctor \<alpha> \<AA> \<BB> \<FF>"

	abbreviation (input) is_cn_semifunctor :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "is_cn_semifunctor \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"

	syntax "_is_cn_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_semifunctor \<alpha> \<AA> \<BB> \<FF>"

	abbreviation all_smcfs :: "V \<Rightarrow> V"
	where "all_smcfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	abbreviation smcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "smcfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"

	lemmas [smc_cs_simps] =
	is_semifunctor.smcf_HomDom
	is_semifunctor.smcf_HomCod
	is_semifunctor.smcf_ArrMap_Comp

	lemma smcf_is_dghm'[slicing_intros]:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<AA>' = smc_dg \<AA>"
	and "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule is_semifunctor.smcf_is_dghm)

	lemma cn_dghm_comp_is_dghm:
	assumes "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "smcf_dghm \<FF> : op_dg (smc_dg \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
	using assms
	unfolding slicing_simps slicing_commute
	by (cs_concl cs_shallow cs_intro: slicing_intros)

	lemma cn_dghm_comp_is_dghm'[slicing_intros]:
	assumes "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<AA>' = op_dg (smc_dg \<AA>)"
	and "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>'"
	using assms(1) unfolding assms(2,3) by (rule cn_dghm_comp_is_dghm)


	text\<open>Rules.\<close>

	lemma (in is_semifunctor) is_semifunctor_axioms'[smc_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_semifunctor_axioms)

	mk_ide rf is_semifunctor_def[unfolded is_semifunctor_axioms_def]
	\|intro is_semifunctorI\|
	\|dest is_semifunctorD[dest]\|
	\|elim is_semifunctorE[elim]\|

	lemmas [smc_cs_intros] =
	is_semifunctorD(3,4)

	lemma is_semifunctorI':
	assumes "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "semicategory \<alpha> \<AA>"
	and "semicategory \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (intro is_semifunctorI is_dghmI, unfold smcf_dghm_components slicing_simps)
	(simp_all add: assms smcf_dghm_def nat_omega_simps semicategory.smc_digraph)

	lemma is_semifunctorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "semicategory \<alpha> \<AA>"
	and "semicategory \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	simp_all add:
	is_semifunctorD(2-9)[OF assms]
	is_dghmD[OF is_semifunctorD(6)[OF assms], unfolded slicing_simps]
	)

	lemma is_semifunctorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<Z> \<alpha>"
	and "vfsequence \<FF>"
	and "semicategory \<alpha> \<AA>"
	and "semicategory \<alpha> \<BB>"
	and "vcard \<FF> = 4\<^sub>\<nat>"
	and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
	and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
	and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
	and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	using assms by (simp add: is_semifunctorD')


	text\<open>Slicing.\<close>

	context is_semifunctor
	begin

	interpretation dghm: is_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule smcf_is_dghm)

	sublocale ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	by (rule dghm.ObjMap.vsv_axioms[unfolded slicing_simps])
	sublocale ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	by (rule dghm.ArrMap.vsv_axioms[unfolded slicing_simps])

	lemmas_with [unfolded slicing_simps]:
	smcf_ObjMap_vsv = dghm.dghm_ObjMap_vsv
	and smcf_ArrMap_vsv = dghm.dghm_ArrMap_vsv
	and smcf_ObjMap_vdomain[smc_cs_simps] = dghm.dghm_ObjMap_vdomain
	and smcf_ObjMap_vrange = dghm.dghm_ObjMap_vrange
	and smcf_ArrMap_vdomain[smc_cs_simps] = dghm.dghm_ArrMap_vdomain
	and smcf_ArrMap_is_arr = dghm.dghm_ArrMap_is_arr
	and smcf_ArrMap_is_arr''[smc_cs_intros] = dghm.dghm_ArrMap_is_arr''
	and smcf_ArrMap_is_arr'[smc_cs_intros] = dghm.dghm_ArrMap_is_arr'
	and smcf_ObjMap_app_in_HomCod_Obj[smc_cs_intros] =
	dghm.dghm_ObjMap_app_in_HomCod_Obj
	and smcf_ArrMap_vrange = dghm.dghm_ArrMap_vrange
	and smcf_ArrMap_app_in_HomCod_Arr[smc_cs_intros] =
	dghm.dghm_ArrMap_app_in_HomCod_Arr
	and smcf_ObjMap_vsubset_Vset = dghm.dghm_ObjMap_vsubset_Vset
	and smcf_ArrMap_vsubset_Vset = dghm.dghm_ArrMap_vsubset_Vset
	and smcf_ObjMap_in_Vset = dghm.dghm_ObjMap_in_Vset
	and smcf_ArrMap_in_Vset = dghm.dghm_ArrMap_in_Vset
	and smcf_is_dghm_if_ge_Limit = dghm.dghm_is_dghm_if_ge_Limit
	and smcf_is_arr_HomCod = dghm.dghm_is_arr_HomCod
	and smcf_vimage_dghm_ArrMap_vsubset_Hom =
	dghm.dghm_vimage_dghm_ArrMap_vsubset_Hom

	end

	lemmas [smc_cs_simps] =
	is_semifunctor.smcf_ObjMap_vdomain
	is_semifunctor.smcf_ArrMap_vdomain

	lemmas [smc_cs_intros] =
	is_semifunctor.smcf_ObjMap_app_in_HomCod_Obj
	is_semifunctor.smcf_ArrMap_app_in_HomCod_Arr
	is_semifunctor.smcf_ArrMap_is_arr'


	text\<open>Elementary properties.\<close>

	lemma cn_smcf_ArrMap_Comp[smc_cs_simps]:
	assumes "semicategory \<alpha> \<AA>"
	and "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b"
	and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	proof-
	from assms(3,4) have gf:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_smc \<AA>\<^esub> f\<rparr>"
	by
	(
	force
	intro: is_semifunctor.smcf_ArrMap_Comp[OF assms(2), symmetric]
	simp: slicing_simps smc_op_simps
	)
	from assms show ?thesis
	unfolding gf by (cs_concl cs_shallow cs_simp: smc_op_simps)
	qed

	lemma smcf_eqI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	shows "\<GG> = \<FF>"
	proof-
	interpret L: is_semifunctor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps V_cs_simps)
	show "\<D>\<^sub>\<circ> \<GG> = \<D>\<^sub>\<circ> \<FF>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps V_cs_simps)
	from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by (simp_all add: smc_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
	(auto simp: dghm_field_simps)
	qed auto
	qed

	lemma smcf_dghm_eqI:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	and "smcf_dghm \<GG> = smcf_dghm \<FF>"
	shows "\<GG> = \<FF>"
	proof(rule smcf_eqI)
	from assms(5) have
	"smcf_dghm \<GG>\<lparr>ObjMap\<rparr> = smcf_dghm \<FF>\<lparr>ObjMap\<rparr>"
	"smcf_dghm \<GG>\<lparr>ArrMap\<rparr> = smcf_dghm \<FF>\<lparr>ArrMap\<rparr>"
	by simp_all
	then show "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	unfolding slicing_simps by simp_all
	qed (auto intro: assms(1,2) simp: assms)

	lemma (in is_semifunctor) smcf_def:
	"\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps V_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>Obj\<rparr>, \<FF>\<lparr>Arr\<rparr>, \<FF>\<lparr>Dom\<rparr>, \<FF>\<lparr>Cod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
	by (simp add: nat_omega_simps)
	then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
	unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>"
	for a
	by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
	(simp_all add: nat_omega_simps)
	qed (auto simp: vsv_axioms)

	lemma (in is_semifunctor) smcf_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	note [smc_cs_intros] =
	smcf_ObjMap_in_Vset
	smcf_ArrMap_in_Vset
	HomDom.smc_in_Vset
	HomCod.smc_in_Vset
	from assms(2) show ?thesis
	by (subst smcf_def)
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps cs_intro: smc_cs_intros V_cs_intros
	)
	qed

	lemma (in is_semifunctor) smcf_is_semifunctor_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
	by (rule is_semifunctorI)
	(
	simp_all add:
	assms
	vfsequence_axioms
	smcf_is_dghm_if_ge_Limit
	HomDom.smc_semicategory_if_ge_Limit
	HomCod.smc_semicategory_if_ge_Limit
	smc_cs_simps
	)

	lemma small_all_smcfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	proof(cases \<open>\<Z> \<alpha>\<close>)
	case True
	from is_semifunctor.smcf_in_Vset show ?thesis
	by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
	(auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
	next
	case False
	then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
	then show ?thesis by simp
	qed

	lemma (in is_semifunctor) smcf_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof-
	note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], smc_cs_intros] =
	smcf_ObjMap_vsubset_Vset
	smcf_ArrMap_vsubset_Vset
	from HomDom.smc_semicategory_in_Vset_4 have [smc_cs_intros]:
	"\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	from HomCod.smc_semicategory_in_Vset_4 have [smc_cs_intros]:
	"\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
	by (succ_of_numeral)
	(cs_prems cs_shallow cs_simp: plus_V_succ_right V_cs_simps)
	show ?thesis
	by (subst smcf_def, succ_of_numeral)
	(
	cs_concl
	cs_simp: plus_V_succ_right V_cs_simps smc_cs_simps
	cs_intro: smc_cs_intros V_cs_intros
	)
	qed

	lemma (in \<Z>) all_smcfs_in_Vset:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "all_smcfs \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
	proof(rule vsubset_in_VsetI)
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	show "all_smcfs \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
	proof(intro vsubsetI)
	fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_smcfs \<alpha>"
	then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
	then interpret is_semifunctor \<alpha> \<AA> \<BB> \<FF> .
	show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule smcf_in_Vset_7)
	qed
	from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
	by (cs_concl cs_shallow cs_intro: V_cs_intros Ord_cs_intros)
	qed

	lemma small_smcfs[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
	by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto



	subsection\<open>Opposite semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>

	definition op_smcf :: "V \<Rightarrow> V"
	where "op_smcf \<FF> =
	[\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_smc (\<FF>\<lparr>HomDom\<rparr>), op_smc (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_smcf_components[smc_op_simps]:
	shows "op_smcf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	and "op_smcf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	and "op_smcf \<FF>\<lparr>HomDom\<rparr> = op_smc (\<FF>\<lparr>HomDom\<rparr>)"
	and "op_smcf \<FF>\<lparr>HomCod\<rparr> = op_smc (\<FF>\<lparr>HomCod\<rparr>)"
	unfolding op_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma op_dghm_smcf_dghm[slicing_commute]:
	"op_dghm (smcf_dghm \<FF>) = smcf_dghm (op_smcf \<FF>)"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) = 4\<^sub>\<nat>"
	unfolding op_dghm_def by (auto simp: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (smcf_dghm (op_smcf \<FF>)) = 4\<^sub>\<nat>"
	unfolding smcf_dghm_def by (auto simp: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) = \<D>\<^sub>\<circ> (smcf_dghm (op_smcf \<FF>))"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) \<Longrightarrow>
	op_dghm (smcf_dghm \<FF>)\<lparr>a\<rparr> = smcf_dghm (op_smcf \<FF>)\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold smcf_dghm_def op_smcf_def op_dghm_def dghm_field_simps
	)
	(auto simp: nat_omega_simps slicing_simps slicing_commute)
	qed (auto simp: smcf_dghm_def op_dghm_def)


	subsubsection\<open>Further properties\<close>

	lemma (in is_semifunctor) is_semifunctor_op:
	"op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
	proof(intro is_semifunctorI)
	show "vfsequence (op_smcf \<FF>)" unfolding op_smcf_def by simp
	show "vcard (op_smcf \<FF>) = 4\<^sub>\<nat>"
	unfolding op_smcf_def by (auto simp: nat_omega_simps)
	fix g b c f a assume "g : b \<mapsto>\<^bsub>op_smc \<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>op_smc \<AA>\<^esub> b"
	then have "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b" and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	unfolding smc_op_simps by simp_all
	with is_semifunctor_axioms show
	"op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_smc \<AA>\<^esub> f\<rparr> =
	op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>op_smc \<BB>\<^esub> op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl
	cs_simp: smc_op_simps smc_cs_simps
	cs_intro: smc_op_intros smc_cs_intros
	)
	qed
	(
	auto simp:
	smc_cs_simps
	smc_op_simps
	slicing_simps
	slicing_commute[symmetric]
	is_dghm.is_dghm_op
	smcf_is_dghm
	HomCod.semicategory_op
	HomDom.semicategory_op
	)

	lemma (in is_semifunctor) is_semifunctor_op':
	assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>" and "\<alpha>' = \<alpha>"
	shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_semifunctor_op)

	lemmas is_semifunctor_op'[smc_op_intros] = is_semifunctor.is_semifunctor_op'

	lemma (in is_semifunctor) smcf_op_smcf_op_smcf[smc_op_simps]:
	"op_smcf (op_smcf \<FF>) = \<FF>"
	proof(rule smcf_eqI, unfold smc_op_simps)
	show "op_smcf (op_smcf \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	metis
	HomCod.smc_op_smc_op_smc
	HomDom.smc_op_smc_op_smc
	is_semifunctor.is_semifunctor_op
	is_semifunctor_op
	)
	qed (simp_all add: is_semifunctor_axioms)

	lemmas smcf_op_smcf_op_smcf[smc_op_simps] = is_semifunctor.smcf_op_smcf_op_smcf

	lemma eq_op_smcf_iff[smc_op_simps]:
	assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "op_smcf \<GG> = op_smcf \<FF> \<longleftrightarrow> \<GG> = \<FF>"
	proof
	interpret L: is_semifunctor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	assume prems: "op_smcf \<GG> = op_smcf \<FF>"
	show "\<GG> = \<FF>"
	proof(rule smcf_eqI[OF assms])
	from prems R.smcf_op_smcf_op_smcf L.smcf_op_smcf_op_smcf show
	"\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	by metis+
	from prems R.smcf_op_smcf_op_smcf L.smcf_op_smcf_op_smcf have
	"\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	by auto
	then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (simp_all add: smc_cs_simps)
	qed
	qed auto



	subsection\<open>Composition of covariant semifunctors\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	abbreviation (input) smcf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F" 55)
	where "smcf_comp \<equiv> dghm_comp"


	text\<open>Slicing.\<close>

	lemma smcf_dghm_smcf_comp[slicing_commute]:
	"smcf_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<FF> = smcf_dghm (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)"
	unfolding dghm_comp_def smcf_dghm_def dghm_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemma smcf_comp_ObjMap_vsv[smc_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ObjMap_vsv
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ObjMap_vdomain[smc_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ObjMap_vdomain
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ObjMap_vrange
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ObjMap_app[smc_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ObjMap_app
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map\<close>

	lemma smcf_comp_ArrMap_vsv[smc_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ArrMap_vsv
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ArrMap_vdomain[smc_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ArrMap_vdomain
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ArrMap_vrange
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute
	]
	)
	qed

	lemma smcf_comp_ArrMap_app[smc_cs_simps]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and [simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_comp_ArrMap_app
	[
	OF L.smcf_is_dghm R.smcf_is_dghm,
	unfolded slicing_simps slicing_commute,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Further properties\<close>

	lemma smcf_comp_is_semifunctor[smc_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule is_semifunctorI, unfold dghm_comp_components(3,4))
	show "vfsequence (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)" by (simp add: dghm_comp_def)
	show "vcard (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"
	unfolding dghm_comp_def by (simp add: nat_omega_simps)
	fix g b c f a assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	with assms show "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> =
	(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (cs_concl cs_shallow cs_simp: smc_cs_simps cs_intro: smc_cs_intros)
	qed
	(
	auto
	simp: slicing_commute[symmetric] smc_cs_simps smc_cs_intros
	intro: dg_cs_intros slicing_intros
	)
	qed

	lemma smcf_comp_assoc[smc_cs_simps]:
	assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "(\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)"
	proof(rule smcf_eqI[of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
	interpret \<HH>: is_semifunctor \<alpha> \<CC> \<DD> \<HH> by (rule assms(1))
	interpret \<GG>: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
	interpret \<FF>: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3))
	from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms \<HH>.is_semifunctor_axioms
	show "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (auto intro: smc_cs_intros)
	qed (simp_all add: dghm_comp_components vcomp_assoc)

	lemma op_smcf_smcf_comp[smc_op_simps]:
	"op_smcf (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = op_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F op_smcf \<FF>"
	unfolding dghm_comp_def op_smcf_def dghm_field_simps
	by (simp add: nat_omega_simps)



	subsection\<open>Composition of contravariant semifunctors\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>

	definition smcf_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ>\<close> 55)
	where "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> =
	[
	\<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>,
	\<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>,
	op_smc (\<FF>\<lparr>HomDom\<rparr>),
	\<GG>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smcf_cn_comp_components:
	shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
	and "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
	and [smc_cn_cs_simps]: "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_smc (\<FF>\<lparr>HomDom\<rparr>)"
	and [smc_cn_cs_simps]: "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
	unfolding smcf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smcf_dghm_smcf_cn_comp[slicing_commute]:
	"smcf_dghm \<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> smcf_dghm \<FF> = smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)"
	unfolding dghm_cn_comp_def smcf_cn_comp_def smcf_dghm_def
	by (simp add: nat_omega_simps slicing_commute dghm_field_simps)


	subsubsection\<open>Object map: two contravariant semifunctors\<close>

	lemma smcf_cn_comp_ObjMap_vsv[smc_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ObjMap_vsv
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ObjMap_vdomain[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ObjMap_vdomain
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ObjMap_vrange
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ObjMap_app[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ObjMap_app
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map: two contravariant semifunctors\<close>

	lemma smcf_cn_comp_ArrMap_vsv[smc_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ArrMap_vsv
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ArrMap_vdomain[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ArrMap_vdomain
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ArrMap_vrange
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_comp_ArrMap_app[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_comp_ArrMap_app
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Object map: contravariant and covariant semifunctors\<close>

	lemma smcf_cn_cov_comp_ObjMap_vsv[smc_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ObjMap_vsv
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ObjMap_vdomain[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ObjMap_vdomain
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ObjMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ObjMap_vrange
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ObjMap_app[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ObjMap_app
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Arrow map: contravariant and covariant semifunctors\<close>

	lemma smcf_cn_cov_comp_ArrMap_vsv[smc_cn_cs_intros]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ArrMap_vsv
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ArrMap_vdomain[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ArrMap_vdomain
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ArrMap_vrange:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ArrMap_vrange
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps
	]
	)
	qed

	lemma smcf_cn_cov_comp_ArrMap_app[smc_cn_cs_simps]:
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1))
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	by
	(
	rule dghm_cn_cov_comp_ArrMap_app
	[
	OF
	L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
	R.smcf_is_dghm,
	unfolded slicing_commute slicing_simps,
	OF assms(3)
	]
	)
	qed


	subsubsection\<open>Opposite of the contravariant composition of semifunctors\<close>

	lemma op_smcf_smcf_cn_comp[smc_op_simps]:
	"op_smcf (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) = op_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> op_smcf \<FF>"
	unfolding op_smcf_def smcf_cn_comp_def dghm_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>Further properties\<close>

	lemma smcf_cn_comp_is_semifunctor[smc_cn_cs_intros]:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
	assumes "semicategory \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a
	by (rule assms(2)) (simp_all add: smc_op_simps)
	interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a
	by (rule assms(3)) (simp_all add: smc_op_simps)
	interpret \<AA>: semicategory \<alpha> \<AA> by (rule assms(1))
	show ?thesis
	proof(rule is_semifunctorI, unfold smcf_cn_comp_components(3,4) smc_op_simps)
	from assms show "smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: dg_cn_cs_intros slicing_intros
	)
	fix g b c f a assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	with assms show "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> =
	(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_cn_cs_simps smc_op_simps
	cs_intro: smc_cs_intros
	)
	qed
	(
	auto simp:
	smcf_cn_comp_def
	nat_omega_simps
	smc_cs_simps
	smc_op_simps
	smc_cs_intros
	)
	qed

	lemma smcf_cn_cov_comp_is_semifunctor[smc_cs_intros]:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
	assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG>
	rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a
	by (rule assms(1)) (simp_all add: smc_op_simps)
	interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
	show ?thesis
	proof(rule is_semifunctorI, unfold smcf_cn_comp_components(3,4) smc_op_simps)
	from assms show
	"smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) : smc_dg (op_smc \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: dg_cn_cs_intros slicing_intros
	)
	show "vfsequence (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)" unfolding smcf_cn_comp_def by simp
	show "vcard (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
	unfolding smcf_cn_comp_def by (auto simp: nat_omega_simps)
	show "op_smc (\<FF>\<lparr>HomDom\<rparr>) = op_smc \<AA>" by (simp add: smc_cs_simps)
	show "\<GG>\<lparr>HomCod\<rparr> = \<CC>" by (simp add: smc_cs_simps)
	fix g b c f a assume "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b" "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	with assms show
	"(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> =
	(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_cn_cs_simps smc_op_simps
	cs_intro: smc_cs_intros
	)
	qed (auto intro: smc_cs_intros smc_op_intros)
	qed

	lemma smcf_cov_cn_comp_is_semifunctor[smc_cn_cs_intros]:
	\<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by (rule smcf_comp_is_semifunctor)



	subsection\<open>Identity semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) smcf_id :: "V \<Rightarrow> V" where "smcf_id \<equiv> dghm_id"


	text\<open>Slicing.\<close>

	lemma smcf_dghm_smcf_id[slicing_commute]:
	"dghm_id (smc_dg \<CC>) = smcf_dghm (smcf_id \<CC>)"
	unfolding dghm_id_def smc_dg_def smcf_dghm_def dghm_field_simps dg_field_simps
	by (simp add: nat_omega_simps)

	context semicategory
	begin

	interpretation dg: digraph \<alpha> \<open>smc_dg \<CC>\<close> by (rule smc_digraph)

	lemmas_with [unfolded slicing_simps]:
	smc_dghm_id_is_dghm = dg.dg_dghm_id_is_dghm

	end


	subsubsection\<open>Object map\<close>

	lemmas [smc_cs_simps] = dghm_id_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	lemmas [smc_cs_simps] = dghm_id_ArrMap_app


	subsubsection\<open>Opposite identity semifunctor\<close>

	lemma op_smcf_smcf_id[smc_op_simps]: "op_smcf (smcf_id \<CC>) = smcf_id (op_smc \<CC>)"
	unfolding dghm_id_def op_smc_def op_smcf_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>An identity semifunctor is a semifunctor\<close>

	lemma (in semicategory) smc_smcf_id_is_semifunctor: "smcf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule is_semifunctorI, unfold dghm_id_components)
	from smc_dghm_id_is_dghm show
	"smcf_dghm (smcf_id \<CC>) : smc_dg \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	by (auto simp: slicing_simps slicing_commute)
	fix g b c f a assume "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	then show "vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> =
	vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>f\<rparr>"
	by (metis smc_is_arrD(1) smc_Comp_is_arr vid_on_eq_atI)
	qed (auto simp: semicategory_axioms dghm_id_def nat_omega_simps)

	lemma (in semicategory) smc_smcf_id_is_semifunctor':
	assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
	shows "smcf_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule smc_smcf_id_is_semifunctor)

	lemmas [smc_cs_intros] = semicategory.smc_smcf_id_is_semifunctor'


	subsubsection\<open>Further properties\<close>

	lemma (in is_semifunctor) smcf_smcf_comp_smcf_id_left[smc_cs_simps]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	"smcf_id \<BB> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = \<FF>"
	by (rule smcf_eqI, unfold dghm_id_components dghm_comp_components)
	(auto simp: smcf_ObjMap_vrange smcf_ArrMap_vrange intro: smc_cs_intros)

	lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_id_left

	lemma (in is_semifunctor) smcf_smcf_comp_smcf_id_right[smc_cs_simps]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
	"\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F smcf_id \<AA> = \<FF>"
	by (rule smcf_eqI, unfold dghm_id_components dghm_comp_components)
	(
	auto
	simp: smcf_ObjMap_vrange smcf_ArrMap_vrange smc_cs_simps
	intro: smc_cs_intros
	)

	lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_id_right



	subsection\<open>Constant semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>

	abbreviation (input) smcf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "smcf_const \<equiv> dghm_const"


	text\<open>Slicing.\<close>

	lemma smcf_dghm_smcf_const[slicing_commute]:
	"dghm_const (smc_dg \<CC>) (smc_dg \<DD>) a f = smcf_dghm (smcf_const \<CC> \<DD> a f)"
	unfolding
	dghm_const_def smc_dg_def smcf_dghm_def dghm_field_simps dg_field_simps
	by (simp add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	lemmas [smc_cs_simps] =
	dghm_const_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	lemmas [smc_cs_simps] =
	dghm_const_ArrMap_app


	subsubsection\<open>Opposite constant semifunctor\<close>

	lemma op_smcf_smcf_const[smc_op_simps]:
	"op_smcf (smcf_const \<CC> \<DD> a f) = smcf_const (op_smc \<CC>) (op_smc \<DD>) a f"
	unfolding dghm_const_def op_smc_def op_smcf_def dghm_field_simps dg_field_simps
	by (auto simp: nat_omega_simps)


	subsubsection\<open>A constant semifunctor is a semifunctor\<close>

	lemma smcf_const_is_semifunctor:
	assumes "semicategory \<alpha> \<CC>"
	and "semicategory \<alpha> \<DD>"
	and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
	and [simp]: "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f = f"
	shows "smcf_const \<CC> \<DD> a f : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	interpret \<CC>: semicategory \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: semicategory \<alpha> \<DD> by (rule assms(2))
	show ?thesis
	proof(intro is_semifunctorI, tactic\<open>distinct_subgoals_tac\<close>)
	from assms show
	"smcf_dghm (dghm_const \<CC> \<DD> a f) : smc_dg \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<DD>"
	by
	(
	cs_concl cs_shallow
	cs_simp: slicing_commute[symmetric]
	cs_intro: dg_cs_intros slicing_intros
	)
	show "vfsequence (smcf_const \<CC> \<DD> a f)" unfolding dghm_const_def by simp
	show "vcard (smcf_const \<CC> \<DD> a f) = 4\<^sub>\<nat>"
	unfolding dghm_const_def by (simp add: nat_omega_simps)
	fix g' b c f' a' assume "g' : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b"
	with assms(1-3) show "smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr> =
	smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	by (cs_concl cs_simp: assms(4) smc_cs_simps cs_intro: smc_cs_intros)
	qed (auto simp: assms(1,2) dghm_const_components)
	qed

	lemma smcf_const_is_semifunctor'[smc_cs_intros]:
	assumes "semicategory \<alpha> \<CC>"
	and "semicategory \<alpha> \<DD>"
	and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
	and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f = f"
	and "\<AA> = \<CC>"
	and "\<BB> = \<DD>"
	shows "smcf_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1-4) unfolding assms(5,6) by (rule smcf_const_is_semifunctor)


	subsubsection\<open>Further properties\<close>

	lemma (in is_semifunctor) smcf_smcf_comp_smcf_const[smc_cs_simps]:
	assumes "semicategory \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a" and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
	shows "smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_const \<AA> \<CC> a f"
	proof(rule smcf_dghm_eqI)
	interpret \<CC>: semicategory \<alpha> \<CC> by (rule assms(1))
	from assms(2) show "smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps assms(3) cs_intro: smc_cs_intros
	)
	from assms(2) show "smcf_const \<AA> \<CC> a f : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps assms(3) cs_intro: smc_cs_intros
	)
	from is_dghm.dghm_dghm_comp_dghm_const[
	OF smcf_is_dghm \<CC>.smc_digraph, unfolded slicing_simps, OF assms(2)
	]
	show "smcf_dghm (smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = smcf_dghm (smcf_const \<AA> \<CC> a f)"
	by (cs_prems cs_shallow cs_simp: slicing_simps slicing_commute)
	qed simp_all

	lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_const



	subsection\<open>Faithful semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_ft_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes ft_smcf_is_ft_dghm:
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"

	syntax "_is_ft_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_ft_semifunctor) ft_smcf_is_ft_dghm'[slicing_intros]:
	assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ft_smcf_is_ft_dghm)

	lemmas [slicing_intros] = is_ft_semifunctor.ft_smcf_is_ft_dghm'


	text\<open>Rules.\<close>

	lemma (in is_ft_semifunctor) is_ft_semifunctor_axioms'[smcf_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_ft_semifunctor_axioms)

	mk_ide rf is_ft_semifunctor_def[unfolded is_ft_semifunctor_axioms_def]
	\|intro is_ft_semifunctorI\|
	\|dest is_ft_semifunctorD[dest]\|
	\|elim is_ft_semifunctorE[elim]\|

	lemmas [smcf_cs_intros] = is_ft_semifunctorD(1)

	lemma is_ft_semifunctorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_ft_semifunctorI)
	(
	simp_all add:
	assms(1)
	is_ft_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
	)

	lemma is_ft_semifunctorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	by
	(
	simp_all add:
	is_ft_semifunctorD[OF assms(1)]
	is_ft_dghmD(2)[
	OF is_ft_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_ft_semifunctorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
	using assms by (simp_all add: is_ft_semifunctorD')

	+lemma is_ft_semifunctorI'':
	+ assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<And>a b g f.
	+ \<lbrakk> g : a \<mapsto>\<^bsub>\<AA>\<^esub> b; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b; \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<rbrakk> \<Longrightarrow> g = f"
	+ shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ intro is_ft_semifunctorI assms,
	+ rule is_ft_dghmI'',
	+ unfold slicing_simps,
	+ rule is_semifunctor.smcf_is_dghm[OF assms(1)],
	+ rule assms(2)
	+ )
	+

	text\<open>Elementary properties.\<close>

	context is_ft_semifunctor
	begin

	interpretation dghm: is_ft_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule ft_smcf_is_ft_dghm)

	lemmas_with [unfolded slicing_simps]:
	ft_smcf_v11_on_Hom = dghm.ft_dghm_v11_on_Hom
	+ and ft_smcf_ArrMap_eqD = dghm.ft_dghm_ArrMap_eqD

	end


	subsubsection\<open>Opposite faithful semifunctor\<close>

	lemma (in is_ft_semifunctor) is_ft_semifunctor_op:
	"op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
	by
	(
	rule is_ft_semifunctorI,
	unfold smc_op_simps slicing_simps slicing_commute[symmetric]
	)
	(
	simp_all add:
	is_semifunctor_op is_ft_dghm.ft_dghm_op_dghm_is_ft_dghm
	ft_smcf_is_ft_dghm
	)

	lemma (in is_ft_semifunctor) is_ft_semifunctor_op'[smc_op_intros]:
	assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
	shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_ft_semifunctor_op)

	lemmas is_ft_semifunctor_op[smc_op_intros] =
	is_ft_semifunctor.is_ft_semifunctor_op'


	subsubsection\<open>
	The composition of faithful semifunctors is a faithful semifunctor
	\<close>

	lemma smcf_comp_is_ft_semifunctor[smcf_cs_intros]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_ft_semifunctorI)
	interpret \<GG>: is_ft_semifunctor \<alpha> \<BB> \<CC> \<GG> by (simp add: assms(1))
	interpret \<FF>: is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF> by (simp add: assms(2))
	from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show \<GG>\<FF>:
	"\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: smc_cs_intros)
	then interpret is_semifunctor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>\<close> .
	show "smcf_dghm (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	unfolding slicing_simps slicing_commute[symmetric]
	by (auto intro: dghm_cs_intros slicing_intros)
	qed



	subsection\<open>Full semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_fl_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes fl_smcf_is_fl_dghm:
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"

	syntax "_is_fl_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_fl_semifunctor) fl_smcf_is_fl_dghm'[slicing_intros]:
	assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule fl_smcf_is_fl_dghm)

	lemmas [slicing_intros] = is_fl_semifunctor.fl_smcf_is_fl_dghm'


	text\<open>Rules.\<close>

	mk_ide rf is_fl_semifunctor_def[unfolded is_fl_semifunctor_axioms_def]
	\|intro is_fl_semifunctorI\|
	\|dest is_fl_semifunctorD[dest]\|
	\|elim is_fl_semifunctorE[elim]\|

	lemmas [smcf_cs_intros] = is_fl_semifunctorD(1)

	lemma is_fl_semifunctorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_fl_semifunctorI)
	(
	simp_all add:
	assms(1)
	is_fl_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
	)

	lemma is_fl_semifunctorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	simp_all add:
	is_fl_semifunctorD[OF assms(1)]
	is_fl_dghmD(2)[
	OF is_fl_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_fl_semifunctorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	using assms by (simp_all add: is_fl_semifunctorD')


	text\<open>Elementary properties.\<close>

	context is_fl_semifunctor
	begin

	interpretation dghm: is_fl_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule fl_smcf_is_fl_dghm)

	lemmas_with [unfolded slicing_simps]:
	fl_smcf_surj_on_Hom = dghm.fl_dghm_surj_on_Hom

	end


	subsubsection\<open>Opposite full semifunctor\<close>

	lemma (in is_fl_semifunctor) is_fl_semifunctor_op:
	"op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
	by
	(
	rule is_fl_semifunctorI,
	unfold smc_op_simps slicing_simps slicing_commute[symmetric]
	)
	(
	simp_all add:
	is_semifunctor_op
	is_fl_dghm.fl_dghm_op_dghm_is_fl_dghm
	fl_smcf_is_fl_dghm
	)

	lemma (in is_fl_semifunctor) is_fl_semifunctor_op'[smc_op_intros]:
	assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
	shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_fl_semifunctor_op)

	lemmas is_fl_semifunctor_op[smc_op_intros] =
	is_fl_semifunctor.is_fl_semifunctor_op


	subsubsection\<open>The composition of full semifunctors is a full semifunctor\<close>

	lemma smcf_comp_is_fl_semifunctor[smcf_cs_intros]:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_fl_semifunctorI)
	interpret \<FF>: is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF> using assms(2) by simp
	interpret \<GG>: is_fl_semifunctor \<alpha> \<BB> \<CC> \<GG> using assms(1) by simp
	from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show
	"\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: smc_cs_intros)
	show "smcf_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	unfolding slicing_commute[symmetric]
	by (auto intro: dghm_cs_intros slicing_intros)
	qed



	subsection\<open>Fully faithful semifunctor\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale is_ff_semifunctor =
	is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF> + is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF>

	syntax "_is_ff_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_semifunctor \<alpha> \<AA> \<BB> \<FF>"


	text\<open>Rules.\<close>

	mk_ide rf is_ff_semifunctor_def
	\|intro is_ff_semifunctorI\|
	\|dest is_ff_semifunctorD[dest]\|
	\|elim is_ff_semifunctorE[elim]\|

	lemmas [smcf_cs_intros] = is_ff_semifunctorD


	text\<open>Elementary properties.\<close>

	lemma (in is_ff_semifunctor) ff_smcf_is_ff_dghm:
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
	by (rule is_ff_dghmI) (auto intro: slicing_intros)

	lemma (in is_ff_semifunctor) ff_smcf_is_ff_dghm'[slicing_intros]:
	assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule ff_smcf_is_ff_dghm)

	lemmas [slicing_intros] = is_ff_semifunctor.ff_smcf_is_ff_dghm'


	subsubsection\<open>Opposite fully faithful semifunctor\<close>

	lemma (in is_ff_semifunctor) is_ff_semifunctor_op:
	"op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
	by (rule is_ff_semifunctorI)
	(auto simp: is_fl_semifunctor_op is_ft_semifunctor_op)

	lemma (in is_ff_semifunctor) is_ff_semifunctor_op'[smc_op_intros]:
	assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
	shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule is_ff_semifunctor_op)

	lemmas is_ff_semifunctor_op[smc_op_intros] =
	is_ff_semifunctor.is_ff_semifunctor_op'


	subsubsection\<open>
	The composition of fully faithful semifunctors is a fully faithful
	semifunctor
	\<close>

	lemma smcf_comp_is_ff_semifunctor[smcf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms
	by (intro is_ff_semifunctorI, elim is_ff_semifunctorE)
	(auto intro: smcf_cs_intros)



	subsection\<open>Isomorphism of semicategories\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_iso_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
	assumes iso_smcf_is_iso_dghm:
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"

	syntax "_is_iso_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
	translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF>"

	lemma (in is_iso_semifunctor) iso_smcf_is_iso_dghm'[slicing_intros]:
	assumes "\<AA>' = smc_dg \<AA>" "\<BB>' = smc_dg \<BB>"
	shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule iso_smcf_is_iso_dghm)

	lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'


	text\<open>Rules.\<close>

	lemma (in is_iso_semifunctor) is_iso_semifunctor_axioms'[smcf_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
	shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
	unfolding assms by (rule is_iso_semifunctor_axioms)

	mk_ide rf is_iso_semifunctor_def[unfolded is_iso_semifunctor_axioms_def]
	\|intro is_iso_semifunctorI\|
	\|dest is_iso_semifunctorD[dest]\|
	\|elim is_iso_semifunctorE[elim]\|

	lemma is_iso_semifunctorI':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	by (intro is_iso_semifunctorI)
	(
	simp_all add:
	assms(1)
	is_iso_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
	)

	lemma is_iso_semifunctorD':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by
	(
	simp_all add:
	is_iso_semifunctorD[OF assms(1)]
	is_iso_dghmD(2-5)[
	OF is_iso_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
	]
	)

	lemma is_iso_semifunctorE':
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
	and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	using assms by (simp_all add: is_iso_semifunctorD')


	text\<open>Elementary properties.\<close>

	context is_iso_semifunctor
	begin

	interpretation dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule iso_smcf_is_iso_dghm)

	lemmas_with [unfolded slicing_simps]:
	iso_smcf_ObjMap_vrange[smcf_cs_simps] = dghm.iso_dghm_ObjMap_vrange
	and iso_smcf_ArrMap_vrange[smcf_cs_simps] = dghm.iso_dghm_ArrMap_vrange

	sublocale ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (rule dghm.iso_dghm_ObjMap_v11[unfolded slicing_simps])
	(simp_all add: smc_cs_simps smcf_cs_simps)

	sublocale ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
	rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	by (rule dghm.iso_dghm_ArrMap_v11[unfolded slicing_simps])
	(simp_all add: smc_cs_simps smcf_cs_simps)

	lemmas_with [unfolded slicing_simps]:
	iso_smcf_Obj_HomDom_if_Obj_HomCod[elim] =
	dghm.iso_dghm_Obj_HomDom_if_Obj_HomCod
	and iso_smcf_Arr_HomDom_if_Arr_HomCod[elim] =
	dghm.iso_dghm_Arr_HomDom_if_Arr_HomCod
	and iso_smcf_ObjMap_eqE[elim] = dghm.iso_dghm_ObjMap_eqE
	and iso_smcf_ArrMap_eqE[elim] = dghm.iso_dghm_ArrMap_eqE

	end

	sublocale is_iso_semifunctor \<subseteq> is_ff_semifunctor
	proof-
	interpret dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule iso_smcf_is_iso_dghm)
	show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
	qed

	lemmas (in is_iso_semifunctor) iso_smcf_is_ff_semifunctor =
	is_ff_semifunctor_axioms

	lemmas [smcf_cs_intros] = is_iso_semifunctor.iso_smcf_is_ff_semifunctor


	subsubsection\<open>Opposite isomorphism of semicategories\<close>

	lemma (in is_iso_semifunctor) is_iso_semifunctor_op:
	"op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
	by
	(
	rule is_iso_semifunctorI,
	unfold smc_op_simps slicing_simps slicing_commute[symmetric]
	)
	(
	simp_all add:
	is_semifunctor_op is_iso_dghm.is_iso_dghm_op iso_smcf_is_iso_dghm
	)

	lemmas is_iso_semifunctor_op[smc_op_intros] =
	is_iso_semifunctor.is_iso_semifunctor_op


	subsubsection\<open>
	The composition of isomorphisms of semicategories is an isomorphism of
	semicategories
	\<close>

	lemma smcf_comp_is_iso_semifunctor[smcf_cs_intros]:
	assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_iso_semifunctorI)
	interpret \<FF>: is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF> using assms by auto
	interpret \<GG>: is_iso_semifunctor \<alpha> \<BB> \<CC> \<GG> using assms by auto
	from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show
	"\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: smcf_cs_intros)
	show "smcf_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
	by
	(
	auto
	intro: dghm_cs_intros slicing_intros
	simp: slicing_commute[symmetric]
	)
	qed



	subsection\<open>Inverse semifunctor\<close>

	abbreviation (input) inv_smcf :: "V \<Rightarrow> V"
	where "inv_smcf \<equiv> inv_dghm"

	lemmas [smc_cs_simps] = inv_dghm_components(3,4)


	text\<open>Slicing.\<close>

	lemma dghm_inv_smcf[slicing_commute]:
	"inv_dghm (smcf_dghm \<FF>) = smcf_dghm (inv_smcf \<FF>)"
	unfolding smcf_dghm_def inv_dghm_def dghm_field_simps
	by (simp_all add: nat_omega_simps)

	context is_iso_semifunctor
	begin

	interpretation dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
	by (rule iso_smcf_is_iso_dghm)

	lemmas_with [unfolded slicing_simps slicing_commute]:
	inv_smcf_ObjMap_v11 = dghm.inv_dghm_ObjMap_v11
	and inv_smcf_ObjMap_vdomain = dghm.inv_dghm_ObjMap_vdomain
	and inv_smcf_ObjMap_app = dghm.inv_dghm_ObjMap_app
	and inv_smcf_ObjMap_vrange = dghm.inv_dghm_ObjMap_vrange
	and inv_smcf_ArrMap_v11 = dghm.inv_dghm_ArrMap_v11
	and inv_smcf_ArrMap_vdomain = dghm.inv_dghm_ArrMap_vdomain
	and inv_smcf_ArrMap_app = dghm.inv_dghm_ArrMap_app
	and inv_smcf_ArrMap_vrange = dghm.inv_dghm_ArrMap_vrange
	- and iso_smcf_ObjMap_inv_smcf_ObjMap_app =
	+ and iso_smcf_ObjMap_inv_smcf_ObjMap_app[smcf_cs_simps] =
	dghm.iso_dghm_ObjMap_inv_dghm_ObjMap_app
	- and iso_smcf_ArrMap_inv_smcf_ArrMap_app =
	+ and iso_smcf_ArrMap_inv_smcf_ArrMap_app[smcf_cs_simps] =
	dghm.iso_dghm_ArrMap_inv_dghm_ArrMap_app
	and iso_smcf_HomDom_is_arr_conv = dghm.iso_dghm_HomDom_is_arr_conv
	and iso_smcf_HomCod_is_arr_conv = dghm.iso_dghm_HomCod_is_arr_conv
	+ and iso_inv_smcf_ObjMap_smcf_ObjMap_app[smcf_cs_simps] =
	+ dghm.iso_inv_dghm_ObjMap_dghm_ObjMap_app
	+ and iso_inv_smcf_ArrMap_smcf_ArrMap_app[smcf_cs_simps] =
	+ dghm.iso_inv_dghm_ArrMap_dghm_ArrMap_app

	end

	lemmas [smcf_cs_intros] =
	is_iso_semifunctor.inv_smcf_ObjMap_v11
	is_iso_semifunctor.inv_smcf_ArrMap_v11

	lemmas [smcf_cs_simps] =
	is_iso_semifunctor.inv_smcf_ObjMap_vdomain
	is_iso_semifunctor.inv_smcf_ObjMap_app
	is_iso_semifunctor.inv_smcf_ObjMap_vrange
	is_iso_semifunctor.inv_smcf_ArrMap_vdomain
	is_iso_semifunctor.inv_smcf_ArrMap_app
	is_iso_semifunctor.inv_smcf_ArrMap_vrange
	is_iso_semifunctor.iso_smcf_ObjMap_inv_smcf_ObjMap_app
	is_iso_semifunctor.iso_smcf_ArrMap_inv_smcf_ArrMap_app
	+ is_iso_semifunctor.iso_inv_smcf_ObjMap_smcf_ObjMap_app
	+ is_iso_semifunctor.iso_inv_smcf_ArrMap_smcf_ArrMap_app



	subsection\<open>
	An isomorphism of semicategories is an isomorphism in the category \<open>SemiCAT\<close>
	\<close>

	-lemma is_arr_isomorphism_is_iso_semifunctor:
	+lemma is_iso_arr_is_iso_semifunctor:
	\<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
	and "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> = smcf_id \<BB>"
	shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	proof-
	interpret \<FF>: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
	interpret \<GG>: is_semifunctor \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
	show ?thesis
	proof(rule is_iso_semifunctorI)
	have dg_\<GG>\<FF>\<AA>: "smcf_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<FF> = dghm_id (smc_dg \<AA>)"
	by (simp add: assms(3) smcf_dghm_smcf_id smcf_dghm_smcf_comp)
	have dg_\<FF>\<GG>\<BB>: "smcf_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<GG> = dghm_id (smc_dg \<BB>)"
	by (simp add: assms(4) smcf_dghm_smcf_id smcf_dghm_smcf_comp)
	from \<FF>.smcf_is_dghm \<GG>.smcf_is_dghm dg_\<GG>\<FF>\<AA> dg_\<FF>\<GG>\<BB> show
	"smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
	- by (rule is_arr_isomorphism_is_iso_dghm)
	+ by (rule is_iso_arr_is_iso_dghm)
	qed (simp add: \<FF>.is_semifunctor_axioms)
	qed

	-lemma is_iso_semifunctor_is_arr_isomorphism:
	+lemma is_iso_semifunctor_is_iso_arr:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows [smcf_cs_intros]: "inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	- and "inv_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
	- and "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> = smcf_id \<BB>"
	+ and [smcf_cs_simps]: "inv_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
	+ and [smcf_cs_simps]: "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> = smcf_id \<BB>"
	proof-

	let ?\<GG> = \<open>inv_smcf \<FF>\<close>

	interpret is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))

	- note is_iso_dghm = is_iso_dghm_is_arr_isomorphism[OF iso_smcf_is_iso_dghm]
	+ note is_iso_dghm = is_iso_dghm_is_iso_arr[OF iso_smcf_is_iso_dghm]

	show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	proof
	(
	intro is_iso_semifunctorI is_semifunctorI;
	(unfold slicing_commute[symmetric])?
	)
	show "vfsequence (inv_smcf \<FF>)" unfolding inv_dghm_def by simp
	show "vcard (inv_smcf \<FF>) = 4\<^sub>\<nat>"
	unfolding inv_dghm_def by (simp add: nat_omega_simps)
	show inv_iso_dghm_\<FF>:
	"inv_dghm (smcf_dghm \<FF>) : smc_dg \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<AA>"
	by (rule is_iso_dghm(1))
	show inv_dghm_\<FF>: "inv_dghm (smcf_dghm \<FF>) : smc_dg \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<AA>"
	by (rule is_iso_dghmD(1)[OF inv_iso_dghm_\<FF>])
	fix b c g a f assume prems: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c" "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	note is_arr_inv = is_dghm.dghm_ArrMap_is_arr[
	OF inv_dghm_\<FF>, unfolded slicing_simps slicing_commute
	]
	from prems is_arr_inv[OF prems(1)] is_arr_inv[OF prems(2)] show
	"inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f\<rparr> =
	inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	unfolding inv_dghm_components
	by (intro v11.v11_vconverse_app)
	(
	cs_concl cs_shallow
	cs_intro: smc_cs_intros V_cs_intros
	cs_simp: V_cs_simps smc_cs_simps
	)+
	qed (auto simp: smc_cs_simps intro: smc_cs_intros)

	show "?\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
	proof(rule smcf_eqI, unfold dghm_comp_components inv_dghm_components)
	from \<GG> is_semifunctor_axioms show "inv_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (blast intro: smc_cs_intros)
	qed
	(
	simp_all add:
	HomDom.smc_smcf_id_is_semifunctor
	ObjMap.v11_vcomp_vconverse
	ArrMap.v11_vcomp_vconverse
	dghm_id_components
	)

	show "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> = smcf_id \<BB>"
	proof(rule smcf_eqI, unfold dghm_comp_components inv_dghm_components)
	from \<GG> is_semifunctor_axioms show "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by (blast intro: smc_cs_intros)
	qed
	(
	simp_all add:
	HomCod.smc_smcf_id_is_semifunctor
	ObjMap.v11_vcomp_vconverse'
	ArrMap.v11_vcomp_vconverse'
	dghm_id_components
	)

	qed


	subsubsection\<open>An identity semifunctor is an isomorphism of semicategories\<close>

	lemma (in semicategory) smc_smcf_id_is_iso_semifunctor:
	"smcf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule is_iso_semifunctorI, unfold slicing_simps slicing_commute[symmetric])
	(
	simp_all add:
	smc_smcf_id_is_semifunctor digraph.dg_dghm_id_is_iso_dghm smc_digraph
	)

	lemma (in semicategory) smc_smcf_id_is_iso_semifunctor'[smcf_cs_intros]:
	assumes "\<AA>' = \<CC>" and "\<BB>' = \<CC>"
	shows "smcf_id \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule smc_smcf_id_is_iso_semifunctor)

	lemmas [smcf_cs_intros] = semicategory.smc_smcf_id_is_iso_semifunctor'



	subsection\<open>Isomorphic semicategories\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>

	locale iso_semicategory = L: semicategory \<alpha> \<AA> + R: semicategory \<alpha> \<BB>
	for \<alpha> \<AA> \<BB> +
	assumes iso_smc_is_iso_semifunctor: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"

	notation iso_semicategory (infixl "\<approx>\<^sub>S\<^sub>M\<^sub>C\<index>" 50)


	text\<open>Rules.\<close>

	lemma iso_semicategoryI:
	assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	unfolding iso_semicategory_def iso_semicategory_axioms_def
	by blast

	lemma iso_semicategoryD[dest]:
	assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms
	unfolding iso_semicategory_def iso_semicategory_axioms_def
	by simp_all

	lemma iso_semicategoryE[elim]:
	assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in iso_semicategory) iso_smc_iso_digraph: "smc_dg \<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
	using iso_smc_is_iso_semifunctor
	by (auto intro: slicing_intros iso_digraphI)


	subsubsection\<open>A semicategory isomorphism is an equivalence relation\<close>

	lemma iso_semicategory_refl:
	assumes "semicategory \<alpha> \<AA>"
	shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule iso_semicategoryI[of _ _ _ \<open>smcf_id \<AA>\<close>])
	interpret semicategory \<alpha> \<AA> by (rule assms)
	show "smcf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	by (simp add: smc_smcf_id_is_iso_semifunctor)
	qed

	lemma iso_semicategory_sym[sym]:
	assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "\<BB> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret iso_semicategory \<alpha> \<AA> \<BB> by (rule assms)
	from iso_smc_is_iso_semifunctor obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	by clarsimp
	then have "inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
	- by (simp add: is_iso_semifunctor_is_arr_isomorphism(1))
	+ by (simp add: is_iso_semifunctor_is_iso_arr(1))
	then show ?thesis by (auto intro: iso_semicategoryI)
	qed

	lemma iso_semicategory_trans[trans]:
	assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	interpret L: iso_semicategory \<alpha> \<AA> \<BB> by (rule assms(1))
	interpret R: iso_semicategory \<alpha> \<BB> \<CC> by (rule assms(2))
	from L.iso_smc_is_iso_semifunctor R.iso_smc_is_iso_semifunctor show ?thesis
	by (auto intro: iso_semicategoryI smcf_cs_intros)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Set.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Set.thy
	--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Set.thy
	+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Set.thy
	@@ -1,785 +1,825 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>Set\<close> as a semicategory\<close>
	theory CZH_SMC_Set
	imports
	CZH_DG_Set
	CZH_SMC_Par
	CZH_SMC_Subsemicategory
	begin



	subsection\<open>Background\<close>


	text\<open>
	The methodology chosen for the exposition
	of \<open>Set\<close> as a semicategory is analogous to the
	-one used in the previous chapter for the exposition of \<open>Set\<close> as a digraph.
	+one used in the previous chapter for the exposition
	+of \<open>Set\<close> as a digraph.
	\<close>

	named_theorems smc_Set_cs_simps
	named_theorems smc_Set_cs_intros

	lemmas (in arr_Set) [smc_Set_cs_simps] =
	dg_Rel_shared_cs_simps

	+lemmas (in arr_Set) [smc_cs_intros, smc_Set_cs_intros] =
	+ arr_Set_axioms'
	+
	lemmas [smc_Set_cs_simps] =
	dg_Rel_shared_cs_simps
	arr_Set.arr_Set_ArrVal_vdomain
	arr_Set_comp_Set_id_Set_left
	arr_Set_comp_Set_id_Set_right

	lemmas [smc_Set_cs_intros] =
	dg_Rel_shared_cs_intros
	arr_Set_comp_Set



	subsection\<open>\<open>Set\<close> as a semicategory\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition smc_Set :: "V \<Rightarrow> V"
	where "smc_Set \<alpha> =
	[
	Vset \<alpha>,
	set {T. arr_Set \<alpha> T},
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>),
	(\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>),
	(\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Set \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma smc_Set_components:
	shows "smc_Set \<alpha>\<lparr>Obj\<rparr> = Vset \<alpha>"
	and "smc_Set \<alpha>\<lparr>Arr\<rparr> = set {T. arr_Set \<alpha> T}"
	and "smc_Set \<alpha>\<lparr>Dom\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrDom\<rparr>)"
	and "smc_Set \<alpha>\<lparr>Cod\<rparr> = (\<lambda>T\<in>\<^sub>\<circ>set {T. arr_Set \<alpha> T}. T\<lparr>ArrCod\<rparr>)"
	and "smc_Set \<alpha>\<lparr>Comp\<rparr> = (\<lambda>ST\<in>\<^sub>\<circ>composable_arrs (dg_Set \<alpha>). ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Set_def dg_field_simps by (simp_all add: nat_omega_simps)


	text\<open>Slicing.\<close>

	lemma smc_dg_smc_Set: "smc_dg (smc_Set \<alpha>) = dg_Set \<alpha>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (smc_dg (smc_Set \<alpha>)) = 4\<^sub>\<nat>"
	unfolding smc_dg_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (dg_Set \<alpha>) = 4\<^sub>\<nat>"
	unfolding dg_Set_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> (smc_dg (smc_Set \<alpha>)) = \<D>\<^sub>\<circ> (dg_Set \<alpha>)"
	unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_dg (smc_Set \<alpha>)) \<Longrightarrow> smc_dg (smc_Set \<alpha>)\<lparr>a\<rparr> = dg_Set \<alpha>\<lparr>a\<rparr>"
	for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	unfold smc_dg_def dg_field_simps smc_Set_def dg_Set_def
	)
	(auto simp: nat_omega_simps)
	qed (auto simp: smc_dg_def dg_Set_def)

	lemmas_with [folded smc_dg_smc_Set, unfolded slicing_simps]:
	smc_Set_Obj_iff = dg_Set_Obj_iff
	and smc_Set_Arr_iff[smc_Set_cs_simps] = dg_Set_Arr_iff
	and smc_Set_Dom_vsv[smc_Set_cs_intros] = dg_Set_Dom_vsv
	and smc_Set_Dom_vdomain[smc_Set_cs_simps] = dg_Set_Dom_vdomain
	and smc_Set_Dom_vrange = dg_Set_Dom_vrange
	and smc_Set_Dom_app[smc_Set_cs_simps] = dg_Set_Dom_app
	and smc_Set_Cod_vsv[smc_Set_cs_intros] = dg_Set_Cod_vsv
	and smc_Set_Cod_vdomain[smc_Set_cs_simps] = dg_Set_Cod_vdomain
	and smc_Set_Cod_vrange = dg_Set_Cod_vrange
	and smc_Set_Cod_app[smc_Set_cs_simps] = dg_Set_Cod_app
	and smc_Set_is_arrI = dg_Set_is_arrI
	and smc_Set_is_arrD = dg_Set_is_arrD
	and smc_Set_is_arrE = dg_Set_is_arrE
	and smc_Set_ArrVal_vdomain[smc_Set_cs_simps] = dg_Set_ArrVal_vdomain
	and smc_Set_ArrVal_app_vrange[smc_Set_cs_intros] = dg_Set_ArrVal_app_vrange

	lemmas [smc_cs_simps] = smc_Set_is_arrD(2,3)

	lemmas_with (in \<Z>) [folded smc_dg_smc_Set, unfolded slicing_simps]:
	smc_Set_Hom_vifunion_in_Vset = dg_Set_Hom_vifunion_in_Vset
	and smc_Set_incl_Set_is_arr = dg_Set_incl_Set_is_arr
	- and smc_Set_incl_Set_is_arr'[smc_Set_cs_intros] = dg_Set_incl_Set_is_arr'

	lemmas [smc_Set_cs_intros] =
	smc_Set_is_arrI
	- \<Z>.smc_Set_incl_Set_is_arr'
	+
	+lemma (in \<Z>) smc_Set_incl_Set_is_arr'[smc_cs_intros, smc_Set_cs_intros]:
	+ assumes "A \<in>\<^sub>\<circ> smc_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "B \<in>\<^sub>\<circ> smc_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "A \<subseteq>\<^sub>\<circ> B"
	+ and "A' = A"
	+ and "B' = B"
	+ and "\<CC>' = smc_Set \<alpha>"
	+ shows "incl_Set A B : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1-3) unfolding assms(4-6) by (rule smc_Set_incl_Set_is_arr)
	+
	+lemmas [smc_Set_cs_intros] = \<Z>.smc_Set_incl_Set_is_arr'


	subsubsection\<open>Composable arrows\<close>

	lemma smc_Set_composable_arrs_dg_Set:
	"composable_arrs (dg_Set \<alpha>) = composable_arrs (smc_Set \<alpha>)"
	unfolding composable_arrs_def smc_dg_smc_Set[symmetric] slicing_simps by simp

	lemma smc_Set_Comp:
	"smc_Set \<alpha>\<lparr>Comp\<rparr> =
	VLambda (composable_arrs (smc_Set \<alpha>)) (\<lambda>ST. ST\<lparr>0\<rparr> \<circ>\<^sub>R\<^sub>e\<^sub>l ST\<lparr>1\<^sub>\<nat>\<rparr>)"
	unfolding smc_Set_components smc_Set_composable_arrs_dg_Set ..


	subsubsection\<open>Composition\<close>

	lemma smc_Set_Comp_app[smc_Set_cs_simps]:
	assumes "S : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c" and "T : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b"
	- shows "S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	+ shows "S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = S \<circ>\<^sub>S\<^sub>e\<^sub>t T"
	proof-
	from assms have "[S, T]\<^sub>\<circ> \<in>\<^sub>\<circ> composable_arrs (smc_Set \<alpha>)"
	by (auto simp: smc_cs_intros)
	- then show "S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = S \<circ>\<^sub>R\<^sub>e\<^sub>l T"
	+ then show "S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = S \<circ>\<^sub>S\<^sub>e\<^sub>t T"
	unfolding smc_Set_Comp by (simp add: nat_omega_simps)
	qed

	lemma smc_Set_Comp_vdomain: "\<D>\<^sub>\<circ> (smc_Set \<alpha>\<lparr>Comp\<rparr>) = composable_arrs (smc_Set \<alpha>)"
	unfolding smc_Set_Comp by simp

	lemma (in \<Z>) smc_Set_Comp_vrange:
	"\<R>\<^sub>\<circ> (smc_Set \<alpha>\<lparr>Comp\<rparr>) \<subseteq>\<^sub>\<circ> set {T. arr_Set \<alpha> T}"
	proof(rule vsubsetI)
	interpret digraph \<alpha> \<open>smc_dg (smc_Set \<alpha>)\<close>
	unfolding smc_dg_smc_Set by (simp add: digraph_dg_Set)
	fix R assume "R \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (smc_Set \<alpha>\<lparr>Comp\<rparr>)"
	then obtain ST
	where R_def: "R = smc_Set \<alpha>\<lparr>Comp\<rparr>\<lparr>ST\<rparr>"
	and "ST \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Set \<alpha>\<lparr>Comp\<rparr>)"
	unfolding smc_Set_components by (blast dest: rel_VLambda.vrange_atD)
	then obtain S T a b c
	where "ST = [S, T]\<^sub>\<circ>"
	and S: "S : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c"
	and T: "T : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b"
	by (auto simp: smc_Set_Comp_vdomain)
	with R_def have R_def': "R = S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T" by simp
	interpret S: arr_Set \<alpha> S + T: arr_Set \<alpha> T
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = b"
	and [simp]: "S\<lparr>ArrCod\<rparr> = c"
	and [simp]: "T\<lparr>ArrDom\<rparr> = a"
	and [simp]: "T\<lparr>ArrCod\<rparr> = b"
	using S T by (auto elim!: smc_Set_is_arrD)
	have "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	with T.ArrVal.vrange_atD obtain x
	where y_def: "y = T\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>" and x: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	by metis
	from prems x T.arr_Set_ArrVal_vrange show "y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (S\<lparr>ArrVal\<rparr>)"
	unfolding y_def by (auto simp: smc_Set_cs_simps)
	qed
	- with S.arr_Set_axioms T.arr_Set_axioms have "arr_Set \<alpha> (S \<circ>\<^sub>R\<^sub>e\<^sub>l T)"
	+ with S.arr_Set_axioms T.arr_Set_axioms have "arr_Set \<alpha> (S \<circ>\<^sub>S\<^sub>e\<^sub>t T)"
	by (simp add: arr_Set_comp_Set)
	from this show "R \<in>\<^sub>\<circ> set {T. arr_Set \<alpha> T}"
	unfolding R_def' smc_Set_Comp_app[OF S T] by simp
	qed

	lemma smc_Set_composable_vrange_vdomain[smc_Set_cs_intros]:
	assumes "g : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b"
	shows "\<R>\<^sub>\<circ> (f\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (g\<lparr>ArrVal\<rparr>)"
	proof(intro vsubsetI)
	from assms have g: "arr_Set \<alpha> g" and f: "arr_Set \<alpha> f"
	by (auto simp: smc_Set_is_arrD)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (f\<lparr>ArrVal\<rparr>)"
	with assms f have "y \<in>\<^sub>\<circ> b" by (force simp: smc_Set_is_arrD(3))
	with assms g show "y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (g\<lparr>ArrVal\<rparr>)"
	by (simp add: smc_Set_is_arrD(2) arr_SetD(5))
	qed

	lemma smc_Set_Comp_ArrVal[smc_cs_simps]:
	assumes "S : y \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> z" and "T : x \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> y" and "a \<in>\<^sub>\<circ> x"
	shows "(S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = S\<lparr>ArrVal\<rparr>\<lparr>T\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<rparr>"
	proof-
	interpret S: arr_Set \<alpha> S + T: arr_Set \<alpha> T
	using assms by (auto simp: smc_Set_is_arrD)
	have Ta: "T\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> y"
	proof-
	from assms have "a \<in>\<^sub>\<circ> T\<lparr>ArrDom\<rparr>" by (auto simp: smc_Set_is_arrD)
	with assms T.arr_Set_ArrVal_vrange show ?thesis
	by
	(
	simp add:
	T.ArrVal.vsv_vimageI2 vsubset_iff smc_Set_is_arrD smc_Set_cs_simps
	)
	qed
	from Ta assms S.arr_Set_axioms T.arr_Set_axioms show ?thesis
	- by ((cs_concl_step smc_Set_cs_simps)+, intro arr_Set_comp_Set_ArrVal[of \<alpha>])
	+ by ((cs_concl_step smc_Set_cs_simps)+, intro arr_Set_comp_Set_ArrVal_app[of \<alpha>])
	(simp_all add: smc_Set_is_arrD smc_Set_cs_simps)
	qed


	subsubsection\<open>\<open>Set\<close> is a semicategory\<close>

	lemma (in \<Z>) semicategory_smc_Set: "semicategory \<alpha> (smc_Set \<alpha>)"
	proof(rule semicategoryI, unfold smc_dg_smc_Set)

	interpret wide_subdigraph \<alpha> \<open>dg_Set \<alpha>\<close> \<open>dg_Par \<alpha>\<close>
	by (rule wide_subdigraph_dg_Set_dg_Par)
	interpret smc_Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)

	show "vfsequence (smc_Set \<alpha>)" unfolding smc_Set_def by simp
	show "vcard (smc_Set \<alpha>) = 5\<^sub>\<nat>"
	unfolding smc_Set_def by (simp add: nat_omega_simps)

	show "(gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (smc_Set \<alpha>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
	(\<exists>g f b c a. gf = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c \<and> f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b)"
	for gf
	unfolding smc_Set_Comp_vdomain by (auto intro: composable_arrsI)

	show [intro]: "g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c"
	if "g : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c" "f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b" for g b c f a
	proof-
	from that have g: "arr_Set \<alpha> g" and f: "arr_Set \<alpha> f"
	by (auto simp: smc_Set_is_arrD)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Set_cs_simps
	cs_intro: smc_Set_cs_intros
	)
	qed

	show "h \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> f = h \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> (g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> f)"
	if "h : c \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> d"
	and "g : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c"
	and "f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b"
	for h c d g b f a
	proof-
	from that have "arr_Set \<alpha> h" "arr_Set \<alpha> g" "arr_Set \<alpha> f"
	by (auto simp: smc_Set_is_arrD)
	with that show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_cs_simps smc_Set_cs_simps
	cs_intro: smc_Set_cs_intros
	)
	qed

	qed (auto simp: digraph_dg_Set smc_Set_components)


	subsubsection\<open>\<open>Set\<close> is a wide subsemicategory of \<open>Par\<close>\<close>

	lemma (in \<Z>) wide_subsemicategory_smc_Set_smc_Par:
	"smc_Set \<alpha> \<subseteq>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> smc_Par \<alpha>"
	proof-
	interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	interpret Set: semicategory \<alpha> \<open>smc_Set \<alpha>\<close> by (rule semicategory_smc_Set)
	show ?thesis
	proof
	(
	intro wide_subsemicategoryI subsemicategoryI,
	unfold smc_dg_smc_Par smc_dg_smc_Set
	)
	from wide_subdigraph_dg_Set_dg_Par show wsd:
	"dg_Set \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> dg_Par \<alpha>"
	"dg_Set \<alpha> \<subseteq>\<^sub>D\<^sub>G\<^sub>.\<^sub>w\<^sub>i\<^sub>d\<^sub>e\<^bsub>\<alpha>\<^esub> dg_Par \<alpha>"
	by auto
	interpret wide_subdigraph \<alpha> \<open>dg_Set \<alpha>\<close> \<open>dg_Par \<alpha>\<close> by (rule wsd(2))
	show "g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> f = g \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> f"
	if "g : b \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> b" for g b c f a
	proof-
	from that have "g : b \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>dg_Set \<alpha>\<^esub> b"
	by
	(
	cs_concl cs_shallow
	cs_simp: smc_dg_smc_Set[symmetric] cs_intro: slicing_intros
	)+
	then have "g : b \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>dg_Par \<alpha>\<^esub> b"
	by (cs_concl cs_shallow cs_intro: dg_sub_fw_cs_intros)+
	then have "g : b \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> c" and "f : a \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> b"
	unfolding smc_dg_smc_Par[symmetric] slicing_simps by simp_all
	from that this show "g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> f = g \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> f"
	by (cs_concl cs_shallow cs_simp: smc_Set_cs_simps smc_Par_cs_simps)
	qed
	qed (auto simp: smc_cs_intros)
	qed



	subsection\<open>Monic arrow and epic arrow\<close>

	-lemma (in \<Z>) smc_Set_is_monic_arrI:
	+lemma smc_Set_is_monic_arrI:
	\<comment>\<open>See Chapter I-5 in \cite{mac_lane_categories_2010}).\<close>
	assumes "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" and "v11 (T\<lparr>ArrVal\<rparr>)" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	shows "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Set \<alpha>\<^esub> B"
	proof(rule is_monic_arrI)
	+
	+ interpret T: arr_Set \<alpha> T by (intro smc_Set_is_arrD[OF assms(1)])+
	interpret wide_subsemicategory \<alpha> \<open>smc_Set \<alpha>\<close> \<open>smc_Par \<alpha>\<close>
	- by (rule wide_subsemicategory_smc_Set_smc_Par)
	+ by (rule T.wide_subsemicategory_smc_Set_smc_Par)
	interpret v11 \<open>T\<lparr>ArrVal\<rparr>\<close> by (rule assms(2))
	+
	show T: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" by (rule assms(1))
	fix S R A'
	assume S: "S : A' \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> A"
	and R: "R : A' \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> A"
	and TS_TR: "T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> S = T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> R"
	from assms(3) T have "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Par \<alpha>\<^esub> B"
	by (intro smc_Par_is_monic_arrI)
	(auto simp: v11_axioms dest: subsmc_is_arrD)
	moreover from S subsemicategory_axioms have "S : A' \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from R subsemicategory_axioms have "R : A' \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> A"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from T S R TS_TR subsemicategory_axioms have
	"T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> S = T \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> R"
	by (auto simp: smc_sub_bw_cs_simps)
	ultimately show "S = R" by (rule is_monic_arrD(2))
	+
	qed

	-lemma (in \<Z>) smc_Set_is_monic_arrD:
	+lemma smc_Set_is_monic_arrD:
	assumes "T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Set \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" and "v11 (T\<lparr>ArrVal\<rparr>)" and "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	proof-

	- interpret wide_subdigraph \<alpha> \<open>dg_Set \<alpha>\<close> \<open>dg_Par \<alpha>\<close>
	- by (rule wide_subdigraph_dg_Set_dg_Par)
	- interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule semicategory_smc_Par)
	-
	from assms show T: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" by auto
	-
	interpret T: arr_Set \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	- using T by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF T])+
	+
	+ interpret wide_subdigraph \<alpha> \<open>dg_Set \<alpha>\<close> \<open>dg_Par \<alpha>\<close>
	+ by (rule T.wide_subdigraph_dg_Set_dg_Par)
	+ interpret Par: semicategory \<alpha> \<open>smc_Par \<alpha>\<close> by (rule T.semicategory_smc_Par)

	show "v11 (T\<lparr>ArrVal\<rparr>)"
	proof(rule v11I)

	show "vsv ((T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>)"
	proof(rule vsvI)

	fix a b c assume "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>" and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)\<inverse>\<^sub>\<circ>"

	then have bar: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>" and car: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	by auto
	with T.arr_Set_ArrVal_vdomain have [intro]: "b \<in>\<^sub>\<circ> A" "c \<in>\<^sub>\<circ> A" by blast+

	define R where "R = [set {\<langle>0, b\<rangle>}, set {0}, A]\<^sub>\<circ>"
	define S where "S = [set {\<langle>0, c\<rangle>}, set {0}, A]\<^sub>\<circ>"

	have R: "R : set {0} \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> A"
	proof(rule smc_Set_is_arrI)
	show "arr_Set \<alpha> R"
	unfolding R_def
	- by (rule arr_Set_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	+ by (rule T.arr_Set_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: R_def arr_Rel_components)
	interpret R: arr_Set \<alpha> R
	rewrites [simp]: "R\<lparr>ArrDom\<rparr> = set {0}" and [simp]: "R\<lparr>ArrCod\<rparr> = A"
	- using R by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF R])+

	have S: "S : set {0} \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> A"
	proof(rule smc_Set_is_arrI)
	show "arr_Set \<alpha> S"
	unfolding S_def
	- by (rule arr_Set_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	+ by (rule T.arr_Set_vfsequenceI) (auto simp: T.arr_Rel_ArrDom_in_Vset)
	qed (simp_all add: S_def arr_Rel_components)
	interpret S: arr_Set \<alpha> S
	rewrites [simp]: "S\<lparr>ArrDom\<rparr> = set {0}" and [simp]: "S\<lparr>ArrCod\<rparr> = A"
	- using S by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF S])+

	have "T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> R = [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Set_Comp_app[OF T R]
	proof
	(
	rule arr_Set_eqI[of \<alpha>],
	unfold comp_Rel_components arr_Rel_components
	)
	- from R T show "arr_Set \<alpha> (T \<circ>\<^sub>R\<^sub>e\<^sub>l R)"
	+ from R T show "arr_Set \<alpha> (T \<circ>\<^sub>S\<^sub>e\<^sub>t R)"
	by (intro arr_Set_comp_Set)
	(auto elim!: smc_Set_is_arrE simp: smc_Set_cs_simps)
	show "arr_Set \<alpha> [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	- proof(rule arr_Set_vfsequenceI)
	+ proof(rule T.arr_Set_vfsequenceI)
	from T.arr_Rel_ArrVal_vrange bar show "\<R>\<^sub>\<circ> (set {\<langle>0, a\<rangle>}) \<subseteq>\<^sub>\<circ> B" by auto
	- qed (auto simp: T.arr_Rel_ArrCod_in_Vset Axiom_of_Powers)
	+ qed (auto simp: T.arr_Rel_ArrCod_in_Vset T.Axiom_of_Powers)
	show "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> R\<lparr>ArrVal\<rparr> = set {\<langle>0, a\<rangle>}"
	unfolding R_def arr_Rel_components
	proof(rule vsv_eqI, unfold vdomain_vsingleton)
	from bar show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>}) = set {0}" by auto
	with bar show "a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>}) \<Longrightarrow>
	(T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, b\<rangle>})\<lparr>a'\<rparr> = set {\<langle>0, a\<rangle>}\<lparr>a'\<rparr>"
	for a'
	by auto
	qed (auto intro: vsv_vcomp)
	qed (simp_all add: R_def arr_Rel_components)
	moreover have "T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> S = [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	unfolding smc_Set_Comp_app[OF T S]
	proof
	(
	rule arr_Set_eqI[of \<alpha>],
	unfold comp_Rel_components arr_Rel_components
	)
	- from T S show "arr_Set \<alpha> (T \<circ>\<^sub>R\<^sub>e\<^sub>l S)"
	+ from T S show "arr_Set \<alpha> (T \<circ>\<^sub>S\<^sub>e\<^sub>t S)"
	by (intro arr_Set_comp_Set)
	(
	auto simp:
	T.arr_Set_axioms
	smc_Set_is_arrD
	S.arr_Set_ArrVal_vrange
	smc_Set_cs_simps
	)
	show "arr_Set \<alpha> [set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ>"
	- proof(rule arr_Set_vfsequenceI)
	+ proof(rule T.arr_Set_vfsequenceI)
	from T.arr_Rel_ArrVal_vrange bar show "\<R>\<^sub>\<circ> (set {\<langle>0, a\<rangle>}) \<subseteq>\<^sub>\<circ> B" by auto
	- qed (auto simp: T.arr_Rel_ArrCod_in_Vset Axiom_of_Powers)
	+ qed (auto simp: T.arr_Rel_ArrCod_in_Vset T.Axiom_of_Powers)
	show "T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> S\<lparr>ArrVal\<rparr> = set {\<langle>0, a\<rangle>}"
	unfolding S_def arr_Rel_components
	proof(rule vsv_eqI, unfold vdomain_vsingleton)
	from car show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>}) = set {0}" by auto
	with car show "a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>}) \<Longrightarrow>
	(T\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> set {\<langle>0, c\<rangle>})\<lparr>a'\<rparr> = set {\<langle>0, a\<rangle>}\<lparr>a'\<rparr>"
	for a'
	by auto
	qed (auto intro: vsv_vcomp)
	qed (simp_all add: S_def arr_Rel_components)
	ultimately have "T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> R = T \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> S" by simp
	from R S assms this have "R = S" by clarsimp
	then have "R\<lparr>ArrVal\<rparr> = S\<lparr>ArrVal\<rparr>" by simp
	then show "b = c" unfolding R_def S_def arr_Rel_components by simp
	qed clarsimp

	qed auto

	show "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A" by (simp add: smc_Set_cs_simps)

	qed

	-lemma (in \<Z>) smc_Set_is_monic_arr:
	+lemma smc_Set_is_monic_arr:
	"T : A \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>smc_Set \<alpha>\<^esub> B \<longleftrightarrow>
	T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B \<and> v11 (T\<lparr>ArrVal\<rparr>) \<and> \<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A"
	by (rule iffI) (auto simp: smc_Set_is_monic_arrD smc_Set_is_monic_arrI)


	text\<open>
	An epic arrow in \<open>Set\<close> is a total surjective function (see Chapter I-5
	in \cite{mac_lane_categories_2010}).
	\<close>

	-lemma (in \<Z>) smc_Set_is_epic_arrI:
	+lemma smc_Set_is_epic_arrI:
	assumes "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	shows "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Set \<alpha>\<^esub> B"
	proof-
	+
	+ interpret T: arr_Set \<alpha> T
	+ rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	+ by (intro smc_Set_is_arrD[OF assms(1)])+
	+
	interpret wide_subsemicategory \<alpha> \<open>smc_Set \<alpha>\<close> \<open>smc_Par \<alpha>\<close>
	- by (rule wide_subsemicategory_smc_Set_smc_Par)
	+ by (rule T.wide_subsemicategory_smc_Set_smc_Par)
	have epi_T: "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Par \<alpha>\<^esub> B"
	using assms by (meson smc_Par_is_epic_arr subsmc_is_arrD)
	+
	show ?thesis
	proof(rule sdg.is_epic_arrI)
	show T: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" by (rule assms(1))
	fix f g a
	assume prems:
	"f : B \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> a"
	"g : B \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> a"
	"f \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = g \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T"
	from prems(1) subsemicategory_axioms have "f : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> a"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from prems(2) subsemicategory_axioms have "g : B \<mapsto>\<^bsub>smc_Par \<alpha>\<^esub> a"
	by (cs_concl cs_shallow cs_intro: smc_sub_fw_cs_intros)
	moreover from prems T subsemicategory_axioms have
	"f \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T = g \<circ>\<^sub>A\<^bsub>smc_Par \<alpha>\<^esub> T"
	by (auto simp: smc_sub_bw_cs_simps)
	ultimately show "f = g"
	by (rule dg.is_epic_arrD(2)[OF epi_T])
	qed
	+
	qed

	-lemma (in \<Z>) smc_Set_is_epic_arrD:
	+lemma smc_Set_is_epic_arrD:
	assumes "T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Set \<alpha>\<^esub> B"
	shows "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" and "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof-

	- interpret semicategory \<alpha> \<open>smc_Set \<alpha>\<close> by (rule semicategory_smc_Set)
	-
	from assms show T: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" by auto
	interpret T: arr_Set \<alpha> T
	rewrites "T\<lparr>ArrDom\<rparr> = A" and "T\<lparr>ArrCod\<rparr> = B"
	- using T by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF T])+
	+
	+ interpret semicategory \<alpha> \<open>smc_Set \<alpha>\<close> by (rule T.semicategory_smc_Set)
	+
	show "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	proof(intro vsubset_antisym vsubsetI)
	fix b assume [intro]: "b \<in>\<^sub>\<circ> B"
	show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	proof(rule ccontr)
	assume b: "b \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>)"
	define R
	where "R = [vinsert \<langle>b, 0\<rangle> ((B -\<^sub>\<circ> set {b}) \<times>\<^sub>\<circ> set {1}), B, set {0, 1}]\<^sub>\<circ>"
	define S where "S = [B \<times>\<^sub>\<circ> set {1}, B, set {0, 1}]\<^sub>\<circ>"
	have R: "R : B \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {0, 1}"
	unfolding R_def
	- proof(intro smc_Set_is_arrI arr_Set_vfsequenceI, unfold arr_Rel_components)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	+ proof
	+ (
	+ intro smc_Set_is_arrI T.arr_Set_vfsequenceI,
	+ unfold arr_Rel_components
	+ )
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by blast
	qed (auto simp: T.arr_Rel_ArrCod_in_Vset)
	have S: "S : B \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {0, 1}"
	unfolding S_def
	- proof(intro smc_Set_is_arrI arr_Set_vfsequenceI, unfold arr_Rel_components)
	- from Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	+ proof
	+ (
	+ intro smc_Set_is_arrI T.arr_Set_vfsequenceI,
	+ unfold arr_Rel_components
	+ )
	+ from T.Axiom_of_Infinity vone_in_omega show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by blast
	qed (auto simp: T.arr_Rel_ArrCod_in_Vset)
	from b have "R\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr> = S\<lparr>ArrVal\<rparr> \<circ>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	unfolding S_def R_def arr_Rel_components
	by (auto intro!: vsubset_antisym vsubsetI)
	then have "R \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T = S \<circ>\<^sub>A\<^bsub>smc_Set \<alpha>\<^esub> T"
	unfolding smc_Set_Comp_app[OF R T] smc_Set_Comp_app[OF S T]
	by (simp add: R_def S_def arr_Rel_components comp_Rel_def)
	from R S this have "R = S" by (rule is_epic_arrD(2)[OF assms])
	with zero_neq_one show False unfolding R_def S_def by blast
	qed
	qed (use T.arr_Set_ArrVal_vrange in auto)
	+
	qed

	-lemma (in \<Z>) smc_Set_is_epic_arr:
	+lemma smc_Set_is_epic_arr:
	"T : A \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>smc_Set \<alpha>\<^esub> B \<longleftrightarrow> T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B \<and> \<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = B"
	by (rule iffI) (simp_all add: smc_Set_is_epic_arrD smc_Set_is_epic_arrI)



	subsection\<open>Terminal object, initial object and null object\<close>


	-text\<open>An object in \<open>Set\<close> is terminal if and only if it is a singleton
	-set (see Chapter I-5 in \cite{mac_lane_categories_2010}).\<close>
	+text\<open>
	+An object in \<open>Set\<close> is terminal if and only if it is a singleton
	+set (see Chapter I-5 in \cite{mac_lane_categories_2010}).
	+\<close>

	lemma (in \<Z>) smc_Set_obj_terminal:
	"obj_terminal (smc_Set \<alpha>) A \<longleftrightarrow> (\<exists>B\<in>\<^sub>\<circ>Vset \<alpha>. A = set {B})"
	proof-

	interpret semicategory \<alpha> \<open>smc_Set \<alpha>\<close> by (rule semicategory_smc_Set)

	have "(\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B) \<longleftrightarrow> (\<exists>C\<in>\<^sub>\<circ>Vset \<alpha>. B = set {C})"
	for B
	proof(intro iffI ballI)

	assume prems[rule_format]: "\<forall>A\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"

	then obtain T where T0B: "T : 0 \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B" by (meson vempty_is_zet)
	then have B[simp]: "B \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Set_components(1))

	show "\<exists>C\<in>\<^sub>\<circ>Vset \<alpha>. B = set {C}"
	proof(rule ccontr, cases \<open>B = 0\<close>)
	case True
	from prems have "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> 0" if "A \<in>\<^sub>\<circ> Vset \<alpha>" for A
	using that unfolding True by simp
	then obtain T where T: "T : set {0} \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> 0"
	by (metis Axiom_of_Pairing insert_absorb2 vempty_is_zet)
	interpret T: arr_Set \<alpha> T
	rewrites "T\<lparr>ArrDom\<rparr> = set {0}" and "T\<lparr>ArrCod\<rparr> = 0"
	- using T by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF T])+
	from
	T.vdomain_vrange_is_vempty
	T.ArrVal.vdomain_vrange_is_vempty
	T.arr_Set_ArrVal_vrange
	show False
	by (auto simp: smc_Set_cs_simps)
	next
	case False
	assume "\<not>(\<exists>C\<in>\<^sub>\<circ>Vset \<alpha>. B = set {C})"
	with B have "\<nexists>C. B = set {C}" by blast
	with False obtain a b where ab: "a \<noteq> b" "a \<in>\<^sub>\<circ> B" "b \<in>\<^sub>\<circ> B"
	by (metis V_equalityI vemptyE vintersection_vsingleton vsingletonD)
	have "[set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ> : set {0} \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	by (intro smc_Set_is_arrI arr_SetI, unfold arr_Rel_components)
	(auto simp: ab(2) nat_omega_simps)
	moreover from ab have
	"[set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ> : set {0} \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	by (intro smc_Set_is_arrI arr_SetI, unfold arr_Rel_components)
	(auto simp: ab(2) nat_omega_simps)
	moreover with ab have
	"[set {\<langle>0, a\<rangle>}, set {0}, B]\<^sub>\<circ> \<noteq> [set {\<langle>0, b\<rangle>}, set {0}, B]\<^sub>\<circ>"
	by simp
	ultimately show False
	by (metis prems smc_is_arrE smc_Set_components(1))
	qed
	+
	next

	fix A assume prems: "\<exists>b\<in>\<^sub>\<circ>Vset \<alpha>. B = set {b}" "A \<in>\<^sub>\<circ> Vset \<alpha>"
	then obtain b where B_def: "B = set {b}" and b: "b \<in>\<^sub>\<circ> Vset \<alpha>" by blast

	have "vconst_on A b = A \<times>\<^sub>\<circ> set {b}" by (simp add: vconst_on_eq_vtimes)

	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	unfolding B_def
	proof(rule ex1I[of _ \<open>[A \<times>\<^sub>\<circ> set {b}, A, set {b}]\<^sub>\<circ>\<close>])

	show "[A \<times>\<^sub>\<circ> set {b}, A, set {b}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {b}"
	using b
	by
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	(auto simp: prems(2) vconst_on_eq_vtimes[symmetric])

	fix T assume prems: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {b}"

	interpret T: arr_Set \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = A" and [simp]: "T\<lparr>ArrCod\<rparr> = set {b}"
	- using prems by (auto elim!: smc_Set_is_arrE)
	+ by (intro smc_Set_is_arrD[OF prems])+

	have [simp]: "T\<lparr>ArrVal\<rparr> = A \<times>\<^sub>\<circ> set {b}"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	with T.vbrelation_axioms app_vdomainI obtain a b'
	where "x = \<langle>a, b'\<rangle>" and "a \<in>\<^sub>\<circ> A"
	by (metis T.ArrVal.vbrelation_vinE T.arr_Set_ArrVal_vdomain)
	with prems T.arr_Set_ArrVal_vrange show "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> set {b}" by auto
	next
	fix x assume "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> set {b}"
	then obtain a where x_def: "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" by clarsimp
	have "\<D>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = A" by (simp add: smc_Set_cs_simps)
	moreover with
	T.arr_Set_ArrVal_vrange T.ArrVal.vdomain_vrange_is_vempty \<open>a \<in>\<^sub>\<circ> A\<close>
	have "\<R>\<^sub>\<circ> (T\<lparr>ArrVal\<rparr>) = set {b}"
	by auto
	ultimately show "x \<in>\<^sub>\<circ> T\<lparr>ArrVal\<rparr>"
	using \<open>a \<in>\<^sub>\<circ> A\<close>
	unfolding x_def
	by
	(
	metis
	T.ArrVal.vsv_ex1_app1
	T.ArrVal.vsv_vimageI1
	vimage_vdomain
	vsingletonD
	)
	qed

	show "T = [A \<times>\<^sub>\<circ> set {b}, A, set {b}]\<^sub>\<circ>"
	proof(rule arr_Set_eqI[of \<alpha>], unfold arr_Rel_components)
	show "arr_Set \<alpha> [A \<times>\<^sub>\<circ> set {b}, A, set {b}]\<^sub>\<circ>"
	using T.arr_Rel_def T.arr_Set_axioms by auto
	qed (auto simp: T.arr_Set_axioms)

	qed
	qed

	then show ?thesis
	apply(intro iffI obj_terminalI)
	subgoal by (metis smc_is_arrD(2) obj_terminalE)
	subgoal by blast
	subgoal by (metis smc_Set_components(1))
	done

	qed


	-text\<open>An object in \<open>Set\<close> is initial if and only if it is the empty
	-set (see Chapter I-5 in \cite{mac_lane_categories_2010}).\<close>
	+text\<open>
	+An object in \<open>Set\<close> is initial if and only if it is the empty
	+set (see Chapter I-5 in \cite{mac_lane_categories_2010}).
	+\<close>

	lemma (in \<Z>) smc_Set_obj_initial: "obj_initial (smc_Set \<alpha>) A \<longleftrightarrow> A = 0"
	proof-

	interpret semicategory \<alpha> \<open>smc_Set \<alpha>\<close> by (rule semicategory_smc_Set)

	have "(\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B) \<longleftrightarrow> A = 0" for A
	proof(intro iffI ballI)

	assume prems[rule_format]: "\<forall>B\<in>\<^sub>\<circ>Vset \<alpha>. \<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"

	then obtain T where T0B: "T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> 0" by (meson vempty_is_zet)
	then have A[simp]: "A \<in>\<^sub>\<circ> Vset \<alpha>" by (fastforce simp: smc_Set_components(1))

	show "A = 0"
	proof(rule ccontr)
	assume "A \<noteq> 0"
	then obtain a where a: "a \<in>\<^sub>\<circ> A" by (auto dest: trad_foundation)
	from Axiom_of_Powers a have A0:
	"[A \<times>\<^sub>\<circ> set {0}, A, set {0}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {0}"
	by
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	auto
	have A1: "[A \<times>\<^sub>\<circ> set {1}, A, set {1}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {1}"
	proof
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	show "set {1} \<in>\<^sub>\<circ> Vset \<alpha>" by (blast intro: vone_in_omega Axiom_of_Infinity)
	qed auto
	have "[A \<times>\<^sub>\<circ> set {0}, A, set {0, 1}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {0, 1}"
	proof
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	- show "set {[]\<^sub>\<circ>, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (intro Limit_vdoubleton_in_VsetI) (force simp: nat_omega_simps)+
	qed auto
	moreover have
	"[A \<times>\<^sub>\<circ> set {1}, A, set {0, 1}]\<^sub>\<circ> : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> set {0, 1}"
	proof
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	- show "set {[]\<^sub>\<circ>, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	+ show "set {0, 1} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (intro Limit_vdoubleton_in_VsetI) (force simp: nat_omega_simps)+
	qed auto
	moreover from \<open>A \<noteq> 0\<close> one_neq_zero have
	"[A \<times>\<^sub>\<circ> set {0}, A, set {0, 1}]\<^sub>\<circ> \<noteq> [A \<times>\<^sub>\<circ> set {1}, A, set {0, 1}]\<^sub>\<circ>"
	by (blast intro!: vsubset_antisym)
	ultimately show False
	by (metis prems smc_is_arrE smc_Set_components(1))
	qed
	next
	fix B assume prems: "A = 0" "B \<in>\<^sub>\<circ> Vset \<alpha>"
	show "\<exists>!T. T : A \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	proof(rule ex1I[of _ \<open>[0, 0, B]\<^sub>\<circ>\<close>], unfold prems(1))
	show zzB: "[0, 0, B]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	by
	(
	intro smc_Set_is_arrI arr_Set_vfsequenceI,
	unfold arr_Rel_components
	)
	(simp_all add: prems)
	- fix T assume prems: "T : 0 \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	+ fix T assume prems': "T : 0 \<mapsto>\<^bsub>smc_Set \<alpha>\<^esub> B"
	interpret T: arr_Set \<alpha> T
	rewrites [simp]: "T\<lparr>ArrDom\<rparr> = 0" and [simp]: "T\<lparr>ArrCod\<rparr> = B"
	- using prems by (auto simp: smc_Set_is_arrD)
	+ by (intro smc_Set_is_arrD[OF prems'])+
	show "T = [0, 0, B]\<^sub>\<circ>"
	proof(rule arr_Set_eqI[of \<alpha>], unfold arr_Rel_components)
	show "arr_Set \<alpha> T" by (rule T.arr_Set_axioms)
	- from zzB show "arr_Set \<alpha> [[]\<^sub>\<circ>, []\<^sub>\<circ>, B]\<^sub>\<circ>" by (meson smc_Set_is_arrE)
	- from T.ArrVal.vdomain_vrange_is_vempty show "T\<lparr>ArrVal\<rparr> = []\<^sub>\<circ>"
	+ from zzB show "arr_Set \<alpha> [0, 0, B]\<^sub>\<circ>" by (meson smc_Set_is_arrE)
	+ from T.ArrVal.vdomain_vrange_is_vempty show "T\<lparr>ArrVal\<rparr> = 0"
	by (auto intro: T.ArrVal.vsv_vrange_vempty simp: smc_Set_cs_simps)
	qed simp_all
	qed
	qed

	then show ?thesis
	apply(intro iffI obj_initialI, elim obj_initialE)
	subgoal by (metis smc_Set_components(1))
	subgoal by (simp add: smc_Set_components(1))
	subgoal by (metis smc_Set_components(1))
	done

	qed


	text\<open>
	-There are no null objects in \<open>Set\<close> (this is a trivial corollary of the
	-above).
	+There are no null objects in \<open>Set\<close> (this is a trivial corollary of the above).
	\<close>

	lemma (in \<Z>) smc_Set_obj_null: "obj_null (smc_Set \<alpha>) A \<longleftrightarrow> False"
	unfolding obj_null_def smc_Set_obj_terminal smc_Set_obj_initial by simp



	subsection\<open>Zero arrow\<close>


	text\<open>
	There are no zero arrows in \<open>Set\<close> (this result is a trivial
	corollary of the absence of null objects).
	\<close>

	lemma (in \<Z>) smc_Set_is_zero_arr: "T : A \<mapsto>\<^sub>0\<^bsub>smc_Set \<alpha>\<^esub> B \<longleftrightarrow> False"
	using smc_Set_obj_null unfolding is_zero_arr_def by auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_BRelations.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_BRelations.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_BRelations.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_BRelations.thy
	@@ -1,2849 +1,2854 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Elementary binary relations\<close>
	theory CZH_Sets_BRelations
	imports CZH_Sets_Sets
	keywords "mk_VLambda" :: thy_defn
	and "\|app" "\|vsv" "\|vdomain"
	begin



	subsection\<open>Background\<close>


	text\<open>
	This section presents a theory of binary relations internalized in the
	type \<^typ>\<open>V\<close> and exposes elementary properties of two special types of
	binary relations: single-valued binary relations and injective single-valued
	binary relations.

	Many of the results that are presented in this section were carried over
	(with amendments) from the theories \<^text>\<open>Set\<close> and \<^text>\<open>Relation\<close> in the main
	library.
	\<close>



	subsection\<open>Constructors\<close>


	subsubsection\<open>Identity relation\<close>

	definition vid_on :: "V \<Rightarrow> V"
	where "vid_on A = set {\<langle>a, a\<rangle> \| a. a \<in>\<^sub>\<circ> A}"

	lemma vid_on_small[simp]: "small {\<langle>a, a\<rangle> \| a. a \<in>\<^sub>\<circ> A}"
	by (rule down[of _ \<open>A \<times>\<^sub>\<circ> A\<close>]) blast


	text\<open>Rules.\<close>

	lemma vid_on_eqI:
	assumes "a = b" and "a \<in>\<^sub>\<circ> A"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vid_on A"
	using assms by (simp add: vid_on_def)

	lemma vid_onI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "\<langle>a, a\<rangle> \<in>\<^sub>\<circ> vid_on A"
	by (rule vid_on_eqI) (simp_all add: assms)

	lemma vid_onD[dest!]:
	assumes "\<langle>a, a\<rangle> \<in>\<^sub>\<circ> vid_on A"
	shows "a \<in>\<^sub>\<circ> A"
	using assms unfolding vid_on_def by auto

	lemma vid_onE[elim!]:
	assumes "x \<in>\<^sub>\<circ> vid_on A" and "\<exists>a\<in>\<^sub>\<circ>A. x = \<langle>a, a\<rangle> \<Longrightarrow> P"
	shows P
	using assms unfolding vid_on_def by auto

	lemma vid_on_iff: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vid_on A \<longleftrightarrow> a = b \<and> a \<in>\<^sub>\<circ> A" by auto


	text\<open>Set operations.\<close>

	lemma vid_on_vempty[simp]: "vid_on 0 = 0" by auto

	lemma vid_on_vsingleton[simp]: "vid_on (set {a}) = set {\<langle>a, a\<rangle>}" by auto

	lemma vid_on_vdoubleton[simp]: "vid_on (set {a, b}) = set {\<langle>a, a\<rangle>, \<langle>b, b\<rangle>}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vid_on_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "vid_on A \<subseteq>\<^sub>\<circ> vid_on B"
	using assms by auto

	lemma vid_on_vinsert: "(vinsert \<langle>a, a\<rangle> (vid_on A)) = (vid_on (vinsert a A))"
	by auto

	lemma vid_on_vintersection: "vid_on (A \<inter>\<^sub>\<circ> B) = vid_on A \<inter>\<^sub>\<circ> vid_on B" by auto

	lemma vid_on_vunion: "vid_on (A \<union>\<^sub>\<circ> B) = vid_on A \<union>\<^sub>\<circ> vid_on B" by auto

	lemma vid_on_vdiff: "vid_on (A -\<^sub>\<circ> B) = vid_on A -\<^sub>\<circ> vid_on B" by auto


	text\<open>Special properties.\<close>

	lemma vid_on_vsubset_vtimes: "vid_on A \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> A" by clarsimp

	lemma VLambda_id[simp]: "VLambda A id = vid_on A"
	by (simp add: id_def vid_on_def Setcompr_eq_image VLambda_def)


	subsubsection\<open>Constant function\<close>

	definition vconst_on :: "V \<Rightarrow> V \<Rightarrow> V"
	where "vconst_on A c = set {\<langle>a, c\<rangle> \| a. a \<in>\<^sub>\<circ> A}"

	lemma small_vconst_on[simp]: "small {\<langle>a, c\<rangle> \| a. a \<in>\<^sub>\<circ> A}"
	by (rule down[of _ \<open>A \<times>\<^sub>\<circ> set {c}\<close>]) auto


	text\<open>Rules.\<close>

	lemma vconst_onI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vconst_on A c"
	using assms unfolding vconst_on_def by simp

	lemma vconst_onD[dest!]:
	assumes "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vconst_on A c"
	shows "a \<in>\<^sub>\<circ> A"
	using assms unfolding vconst_on_def by simp

	lemma vconst_onE[elim!]:
	assumes "x \<in>\<^sub>\<circ> vconst_on A c"
	obtains a where "a \<in>\<^sub>\<circ> A" and "x = \<langle>a, c\<rangle>"
	using assms unfolding vconst_on_def by auto

	lemma vconst_on_iff: "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vconst_on A c \<longleftrightarrow> a \<in>\<^sub>\<circ> A" by auto


	text\<open>Set operations.\<close>

	lemma vconst_on_vempty[simp]: "vconst_on 0 c = 0"
	unfolding vconst_on_def by auto

	lemma vconst_on_vsingleton[simp]: "vconst_on (set {a}) c = set {\<langle>a, c\<rangle>}" by auto

	lemma vconst_on_vdoubleton[simp]: "vconst_on (set {a, b}) c = set {\<langle>a, c\<rangle>, \<langle>b, c\<rangle>}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vconst_on_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "vconst_on A c \<subseteq>\<^sub>\<circ> vconst_on B c"
	using assms by auto

	lemma vconst_on_vinsert:
	"(vinsert \<langle>a, c\<rangle> (vconst_on A c)) = (vconst_on (vinsert a A) c)"
	by auto

	lemma vconst_on_vintersection:
	"vconst_on (A \<inter>\<^sub>\<circ> B) c = vconst_on A c \<inter>\<^sub>\<circ> vconst_on B c"
	by auto

	lemma vconst_on_vunion: "vconst_on (A \<union>\<^sub>\<circ> B) c = vconst_on A c \<union>\<^sub>\<circ> vconst_on B c"
	by auto

	lemma vconst_on_vdiff: "vconst_on (A -\<^sub>\<circ> B) c = vconst_on A c -\<^sub>\<circ> vconst_on B c"
	by auto


	text\<open>Special properties.\<close>

	lemma vconst_on_eq_vtimes: "vconst_on A c = A \<times>\<^sub>\<circ> set {c}"
	by standard (auto intro!: vsubset_antisym)


	subsubsection\<open>\<open>VLambda\<close>\<close>


	text\<open>Rules.\<close>

	lemma VLambdaI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "\<langle>a, f a\<rangle> \<in>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	using assms unfolding VLambda_def by auto

	lemma VLambdaD[dest!]:
	assumes "\<langle>a, f a\<rangle> \<in>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	shows "a \<in>\<^sub>\<circ> A"
	using assms unfolding VLambda_def by auto

	lemma VLambdaE[elim!]:
	assumes "x \<in>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	obtains a where "a \<in>\<^sub>\<circ> A" and "x = \<langle>a, f a\<rangle>"
	using assms unfolding VLambda_def by auto

	lemma VLambda_iff1: "x \<in>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a) \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>A. x = \<langle>a, f a\<rangle>)" by auto

	lemma VLambda_iff2: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a) \<longleftrightarrow> b = f a \<and> a \<in>\<^sub>\<circ> A" by auto

	lemma small_VLambda[simp]: "small {\<langle>a, f a\<rangle> \| a. a \<in>\<^sub>\<circ> A}" by auto

	lemma VLambda_set_def: "(\<lambda>a\<in>\<^sub>\<circ>A. f a) = set {\<langle>a, f a\<rangle> \| a. a \<in>\<^sub>\<circ> A}" by auto


	text\<open>Set operations.\<close>

	lemma VLambda_vempty[simp]: "(\<lambda>a\<in>\<^sub>\<circ>0. f a) = 0" by auto

	lemma VLambda_vsingleton(not simp): "(\<lambda>a\<in>\<^sub>\<circ>set {a}. f a) = set {\<langle>a, f a\<rangle>}"
	by auto

	lemma VLambda_vdoubleton(not simp):
	"(\<lambda>a\<in>\<^sub>\<circ>set {a, b}. f a) = set {\<langle>a, f a\<rangle>, \<langle>b, f b\<rangle>}"
	by (auto simp: vinsert_set_insert_eq)

	lemma VLambda_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "(\<lambda>a\<in>\<^sub>\<circ>A. f a) \<subseteq>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>B. f a)"
	using assms by auto

	lemma VLambda_vinsert:
	"(\<lambda>a\<in>\<^sub>\<circ>vinsert a A. f a) = (\<lambda>a\<in>\<^sub>\<circ>set {a}. f a) \<union>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	by auto

	lemma VLambda_vintersection: "(\<lambda>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> B. f a) = (\<lambda>a\<in>\<^sub>\<circ>A. f a) \<inter>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>B. f a)"
	by auto

	lemma VLambda_vunion: "(\<lambda>a\<in>\<^sub>\<circ>A \<union>\<^sub>\<circ> B. f a) = (\<lambda>a\<in>\<^sub>\<circ>A. f a) \<union>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>B. f a)" by auto

	lemma VLambda_vdiff: "(\<lambda>a\<in>\<^sub>\<circ>A -\<^sub>\<circ> B. f a) = (\<lambda>a\<in>\<^sub>\<circ>A. f a) -\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>B. f a)" by auto


	text\<open>Connections.\<close>

	lemma VLambda_vid_on: "(\<lambda>a\<in>\<^sub>\<circ>A. a) = vid_on A" by auto

	lemma VLambda_vconst_on: "(\<lambda>a\<in>\<^sub>\<circ>A. c) = vconst_on A c" by auto


	subsubsection\<open>Composition\<close>

	definition vcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixr "\<circ>\<^sub>\<circ>" 75)
	where "r \<circ>\<^sub>\<circ> s = set {\<langle>a, c\<rangle> \| a c. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> s \<and> \<langle>b, c\<rangle> \<in>\<^sub>\<circ> r}"
	notation vcomp (infixr \<open>\<circ>\<^sub>\<circ>\<close> 75)

	lemma vcomp_small[simp]: "small {\<langle>a, c\<rangle> \| a c. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> s \<and> \<langle>b, c\<rangle> \<in>\<^sub>\<circ> r}"
	(is \<open>small ?s\<close>)
	proof-
	define comp' where "comp' = (\<lambda>\<langle>\<langle>a, b\<rangle>, \<langle>c, d\<rangle>\<rangle>. \<langle>a, d\<rangle>)"
	have "small (elts (vpairs (s \<times>\<^sub>\<circ> r)))" by simp
	then have small_comp: "small (comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r)))" by simp
	have ss: "?s \<subseteq> (comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r)))"
	proof
	fix x assume "x \<in> ?s"
	then obtain a b c where x_def: "x = \<langle>a, c\<rangle>"
	and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s"
	and "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r"
	by auto
	then have abbc: "\<langle>\<langle>a, b\<rangle>, \<langle>b, c\<rangle>\<rangle> \<in>\<^sub>\<circ> vpairs (s \<times>\<^sub>\<circ> r)"
	by (simp add: vpairs_iff_elts)
	have x_def': "x = comp' \<langle>\<langle>a, b\<rangle>, \<langle>b, c\<rangle>\<rangle>" unfolding comp'_def x_def by auto
	then show "x \<in> comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r))"
	unfolding x_def' using abbc by auto
	qed
	with small_comp show ?thesis by (metis (lifting) smaller_than_small)
	qed


	text\<open>Rules.\<close>

	lemma vcompI[intro!]:
	assumes "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s"
	shows "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	using assms unfolding vcomp_def by auto

	lemma vcompD[dest!]:
	assumes "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	shows "\<exists>b. \<langle>b, c\<rangle> \<in>\<^sub>\<circ> r \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> s"
	using assms unfolding vcomp_def by auto

	lemma vcompE[elim!]:
	assumes "ac \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	obtains a b c where "ac = \<langle>a, c\<rangle>" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s" and "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vcomp_def by clarsimp


	text\<open>Elementary properties.\<close>

	lemma vcomp_assoc: "(r \<circ>\<^sub>\<circ> s) \<circ>\<^sub>\<circ> t = r \<circ>\<^sub>\<circ> (s \<circ>\<^sub>\<circ> t)" by auto


	text\<open>Set operations.\<close>

	lemma vcomp_vempty_left[simp]: "0 \<circ>\<^sub>\<circ> r = 0" by auto

	lemma vcomp_vempty_right[simp]: "r \<circ>\<^sub>\<circ> 0 = 0" by auto

	lemma vcomp_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "s' \<subseteq>\<^sub>\<circ> s"
	shows "r' \<circ>\<^sub>\<circ> s' \<subseteq>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	using assms by auto

	lemma vcomp_vinsert_left[simp]:
	"(vinsert \<langle>a, b\<rangle> s) \<circ>\<^sub>\<circ> r = (set {\<langle>a, b\<rangle>} \<circ>\<^sub>\<circ> r) \<union>\<^sub>\<circ> (s \<circ>\<^sub>\<circ> r)"
	by auto

	lemma vcomp_vinsert_right[simp]:
	"r \<circ>\<^sub>\<circ> (vinsert \<langle>a, b\<rangle> s) = (r \<circ>\<^sub>\<circ> set {\<langle>a, b\<rangle>}) \<union>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s)"
	by auto

	lemma vcomp_vunion_left[simp]: "(s \<union>\<^sub>\<circ> t) \<circ>\<^sub>\<circ> r = (s \<circ>\<^sub>\<circ> r) \<union>\<^sub>\<circ> (t \<circ>\<^sub>\<circ> r)" by auto

	lemma vcomp_vunion_right[simp]: "r \<circ>\<^sub>\<circ> (s \<union>\<^sub>\<circ> t) = (r \<circ>\<^sub>\<circ> s) \<union>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> t)" by auto


	text\<open>Connections.\<close>

	lemma vcomp_vid_on_idem[simp]: "vid_on A \<circ>\<^sub>\<circ> vid_on A = vid_on A" by auto

	lemma vcomp_vid_on[simp]: "vid_on A \<circ>\<^sub>\<circ> vid_on B = vid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma vcomp_vconst_on_vid_on[simp]: "vconst_on A c \<circ>\<^sub>\<circ> vid_on A = vconst_on A c"
	by auto

	lemma vcomp_VLambda_vid_on[simp]: "(\<lambda>a\<in>\<^sub>\<circ>A. f a) \<circ>\<^sub>\<circ> vid_on A = (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	by auto


	text\<open>Special properties.\<close>

	lemma vcomp_vsubset_vtimes:
	assumes "r \<subseteq>\<^sub>\<circ> B \<times>\<^sub>\<circ> C" and "s \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	shows "r \<circ>\<^sub>\<circ> s \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> C"
	using assms by auto

	lemma vcomp_obtain_middle[elim]:
	assumes "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	obtains b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s" and "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r"
	using assms by auto


	subsubsection\<open>Converse relation\<close>

	definition vconverse :: "V \<Rightarrow> V"
	where "vconverse A = (\<lambda>r\<in>\<^sub>\<circ>A. set {\<langle>b, a\<rangle> \| a b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vconverse (\<open>(_\<inverse>\<^sub>\<circ>)\<close> [1000] 999)
	where "r\<inverse>\<^sub>\<circ> \<equiv> vconverse (set {r}) \<lparr>r\<rparr>"

	lemma app_vconverse_def: "r\<inverse>\<^sub>\<circ> = set {\<langle>b, a\<rangle> \| a b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vconverse_def by simp

	lemma vconverse_small[simp]: "small {\<langle>b, a\<rangle> \| a b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have eq: "{\<langle>b, a\<rangle> \| a b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} = (\<lambda>\<langle>a, b\<rangle>. \<langle>b, a\<rangle>) ` elts (vpairs r)"
	proof(rule subset_antisym; rule subsetI, unfold mem_Collect_eq)
	fix x assume "x \<in> (\<lambda>\<langle>a, b\<rangle>. \<langle>b, a\<rangle>) ` elts (vpairs r)"
	then obtain a b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vpairs r" and "x = (\<lambda>\<langle>a, b\<rangle>. \<langle>b, a\<rangle>) \<langle>a, b\<rangle>"
	by blast
	then show "\<exists>a b. x = \<langle>b, a\<rangle> \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
	qed (use image_iff vpairs_iff_elts in fastforce)
	show ?thesis unfolding eq by (rule replacement) auto
	qed


	text\<open>Rules.\<close>

	lemma vconverseI[intro!]:
	assumes "r \<in>\<^sub>\<circ> A"
	shows "\<langle>r, r\<inverse>\<^sub>\<circ>\<rangle> \<in>\<^sub>\<circ> vconverse A"
	using assms unfolding vconverse_def by auto

	lemma vconverseD[dest]:
	assumes "\<langle>r, s\<rangle> \<in>\<^sub>\<circ> vconverse A"
	shows "r \<in>\<^sub>\<circ> A" and "s = r\<inverse>\<^sub>\<circ>"
	using assms unfolding vconverse_def by auto

	lemma vconverseE[elim]:
	assumes "x \<in>\<^sub>\<circ> vconverse A"
	obtains r where "x = \<langle>r, r\<inverse>\<^sub>\<circ>\<rangle>" and "r \<in>\<^sub>\<circ> A"
	using assms unfolding vconverse_def by auto

	lemma app_vconverseI[sym, intro!]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	using assms unfolding vconverse_def by auto

	lemma app_vconverseD[sym, dest]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	shows "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vconverse_def by simp

	lemma app_vconverseE[elim!]:
	assumes "x \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	obtains a b where "x = \<langle>b, a\<rangle>" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vconverse_def by auto

	lemma vconverse_iff: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto


	text\<open>Set operations.\<close>

	lemma vconverse_vempty[simp]: "0\<inverse>\<^sub>\<circ> = 0" by auto

	lemma vconverse_vsingleton: "(set {\<langle>a, b\<rangle>})\<inverse>\<^sub>\<circ> = set {\<langle>b, a\<rangle>}" by auto

	lemma vconverse_vdoubleton[simp]: "(set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>})\<inverse>\<^sub>\<circ> = set {\<langle>b, a\<rangle>, \<langle>d, c\<rangle>}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vconverse_vinsert: "(vinsert \<langle>a, b\<rangle> r)\<inverse>\<^sub>\<circ> = vinsert \<langle>b, a\<rangle> (r\<inverse>\<^sub>\<circ>)" by auto

	lemma vconverse_vintersection: "(r \<inter>\<^sub>\<circ> s)\<inverse>\<^sub>\<circ> = r\<inverse>\<^sub>\<circ> \<inter>\<^sub>\<circ> s\<inverse>\<^sub>\<circ>" by auto

	lemma vconverse_vunion: "(r \<union>\<^sub>\<circ> s)\<inverse>\<^sub>\<circ> = r\<inverse>\<^sub>\<circ> \<union>\<^sub>\<circ> s\<inverse>\<^sub>\<circ>" by auto


	text\<open>Connections.\<close>

	lemma vconverse_vid_on[simp]: "(vid_on A)\<inverse>\<^sub>\<circ> = vid_on A" by auto

	lemma vconverse_vconst_on[simp]: "(vconst_on A c)\<inverse>\<^sub>\<circ> = set {c} \<times>\<^sub>\<circ> A" by auto

	lemma vconverse_vcomp: "(r \<circ>\<^sub>\<circ> s)\<inverse>\<^sub>\<circ> = s\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>" by auto

	lemma vconverse_vtimes: "(A \<times>\<^sub>\<circ> B)\<inverse>\<^sub>\<circ> = (B \<times>\<^sub>\<circ> A)" by auto


	subsubsection\<open>Left restriction\<close>

	definition vlrestriction :: "V \<Rightarrow> V"
	where "vlrestriction D =
	VLambda D (\<lambda>\<langle>r, A\<rangle>. set {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vlrestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>l\<^sub>\<circ>\<close> 80)
	where "r \<restriction>\<^sup>l\<^sub>\<circ> A \<equiv> vlrestriction (set {\<langle>r, A\<rangle>}) \<lparr>\<langle>r, A\<rangle>\<rparr>"

	lemma app_vlrestriction_def: "r \<restriction>\<^sup>l\<^sub>\<circ> A = set {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vlrestriction_def by simp

	lemma vlrestriction_small[simp]: "small {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma vlrestrictionI[intro!]:
	assumes "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D"
	shows "\<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sup>l\<^sub>\<circ> A\<rangle> \<in>\<^sub>\<circ> vlrestriction D"
	using assms unfolding vlrestriction_def by (simp add: VLambda_iff2)

	lemma vlrestrictionD[dest]:
	assumes "\<langle>\<langle>r, A\<rangle>, s\<rangle> \<in>\<^sub>\<circ> vlrestriction D"
	shows "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D" and "s = r \<restriction>\<^sup>l\<^sub>\<circ> A"
	using assms unfolding vlrestriction_def by auto

	lemma vlrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> vlrestriction D" and "D \<subseteq>\<^sub>\<circ> R \<times>\<^sub>\<circ> X"
	obtains r A where "x = \<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sup>l\<^sub>\<circ> A\<rangle>" and "r \<in>\<^sub>\<circ> R" and "A \<in>\<^sub>\<circ> X"
	using assms unfolding vlrestriction_def by auto

	lemma app_vlrestrictionI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> A"
	using assms unfolding vlrestriction_def by simp

	lemma app_vlrestrictionD[dest]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vlrestriction_def by auto

	lemma app_vlrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vlrestriction_def by auto


	text\<open>Set operations.\<close>

	lemma vlrestriction_on_vempty[simp]: "r \<restriction>\<^sup>l\<^sub>\<circ> 0 = 0"
	by (auto intro!: vsubset_antisym)

	lemma vlrestriction_vempty[simp]: "0 \<restriction>\<^sup>l\<^sub>\<circ> A = 0" by auto

	lemma vlrestriction_vsingleton_in[simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sup>l\<^sub>\<circ> A = set {\<langle>a, b\<rangle>}"
	using assms by auto

	lemma vlrestriction_vsingleton_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sup>l\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vlrestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sup>l\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> B"
	using assms by auto

	lemma vlrestriction_vinsert_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sup>l\<^sub>\<circ> A"
	using assms by auto

	lemma vlrestriction_vinsert_in:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sup>l\<^sub>\<circ> A = vinsert \<langle>a, b\<rangle> (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using assms by auto

	lemma vlrestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sup>l\<^sub>\<circ> A \<inter>\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<circ> A" by auto

	lemma vlrestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sup>l\<^sub>\<circ> A \<union>\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<circ> A" by auto

	lemma vlrestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sup>l\<^sub>\<circ> A -\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<circ> A" by auto


	text\<open>Connections.\<close>

	lemma vlrestriction_vid_on[simp]: "(vid_on A) \<restriction>\<^sup>l\<^sub>\<circ> B = vid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma vlrestriction_vconst_on: "(vconst_on A c) \<restriction>\<^sup>l\<^sub>\<circ> B = (vconst_on B c) \<restriction>\<^sup>l\<^sub>\<circ> A"
	by auto

	lemma vlrestriction_vconst_on_commute:
	assumes "x \<in>\<^sub>\<circ> vconst_on A c \<restriction>\<^sup>l\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> vconst_on B c \<restriction>\<^sup>l\<^sub>\<circ> A"
	using assms by auto

	lemma vlrestriction_vcomp[simp]: "(r \<circ>\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<circ>\<^sub>\<circ> (s \<restriction>\<^sup>l\<^sub>\<circ> A)" by auto


	text\<open>Previous connections.\<close>

	lemma vcomp_rel_vid_on[simp]: "r \<circ>\<^sub>\<circ> vid_on A = r \<restriction>\<^sup>l\<^sub>\<circ> A" by auto

	lemma vcomp_vconst_on:
	"r \<circ>\<^sub>\<circ> (vconst_on A c) = (r \<restriction>\<^sup>l\<^sub>\<circ> set {c}) \<circ>\<^sub>\<circ> (vconst_on A c)"
	by auto


	text\<open>Special properties.\<close>

	lemma vlrestriction_vsubset_vpairs: "r \<restriction>\<^sup>l\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> vpairs r"
	by (rule vsubsetI) blast

	lemma vlrestriction_vsubset_rel: "r \<restriction>\<^sup>l\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r" by auto

	lemma vlrestriction_VLambda: "(\<lambda>a\<in>\<^sub>\<circ>A. f a) \<restriction>\<^sup>l\<^sub>\<circ> B = (\<lambda>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> B. f a)" by auto


	subsubsection\<open>Right restriction\<close>

	definition vrrestriction :: "V \<Rightarrow> V"
	where "vrrestriction D =
	VLambda D (\<lambda>\<langle>r, A\<rangle>. set {\<langle>a, b\<rangle> \| a b. b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vrrestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>r\<^sub>\<circ>\<close> 80)
	where "r \<restriction>\<^sup>r\<^sub>\<circ> A \<equiv> vrrestriction (set {\<langle>r, A\<rangle>}) \<lparr>\<langle>r, A\<rangle>\<rparr>"

	lemma app_vrrestriction_def: "r \<restriction>\<^sup>r\<^sub>\<circ> A = set {\<langle>a, b\<rangle> \| a b. b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vrrestriction_def by simp

	lemma vrrestriction_small[simp]: "small {\<langle>a, b\<rangle> \| a b. b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma vrrestrictionI[intro!]:
	assumes "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D"
	shows "\<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sup>r\<^sub>\<circ> A\<rangle> \<in>\<^sub>\<circ> vrrestriction D"
	using assms unfolding vrrestriction_def by (simp add: VLambda_iff2)

	lemma vrrestrictionD[dest]:
	assumes "\<langle>\<langle>r, A\<rangle>, s\<rangle> \<in>\<^sub>\<circ> vrrestriction D"
	shows "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D" and "s = r \<restriction>\<^sup>r\<^sub>\<circ> A"
	using assms unfolding vrrestriction_def by auto

	lemma vrrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> vrrestriction D" and "D \<subseteq>\<^sub>\<circ> R \<times>\<^sub>\<circ> X"
	obtains r A where "x = \<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sup>r\<^sub>\<circ> A\<rangle>" and "r \<in>\<^sub>\<circ> R" and "A \<in>\<^sub>\<circ> X"
	using assms unfolding vrrestriction_def by auto

	lemma app_vrrestrictionI[intro!]:
	assumes "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> A"
	using assms unfolding vrrestriction_def by simp

	lemma app_vrrestrictionD[dest]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrrestriction_def by auto

	lemma app_vrrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrrestriction_def by auto


	text\<open>Set operations.\<close>

	lemma vrrestriction_on_vempty[simp]: "r \<restriction>\<^sup>r\<^sub>\<circ> 0 = 0"
	by (auto intro!: vsubset_antisym)

	lemma vrrestriction_vempty[simp]: "0 \<restriction>\<^sup>r\<^sub>\<circ> A = 0" by auto

	lemma vrrestriction_vsingleton_in[simp]:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sup>r\<^sub>\<circ> A = set {\<langle>a, b\<rangle>}"
	using assms by auto

	lemma vrrestriction_vsingleton_nin[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sup>r\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vrrestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sup>r\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> B"
	using assms by auto

	lemma vrrestriction_vinsert_nin[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sup>r\<^sub>\<circ> A"
	using assms by auto

	lemma vrrestriction_vinsert_in:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sup>r\<^sub>\<circ> A = vinsert \<langle>a, b\<rangle> (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	using assms by auto

	lemma vrrestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sup>r\<^sub>\<circ> A \<inter>\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<circ> A" by auto

	lemma vrrestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sup>r\<^sub>\<circ> A \<union>\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<circ> A" by auto

	lemma vrrestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sup>r\<^sub>\<circ> A -\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<circ> A" by auto


	text\<open>Connections.\<close>

	lemma vrrestriction_vid_on[simp]: "(vid_on A) \<restriction>\<^sup>r\<^sub>\<circ> B = vid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma vrrestriction_vconst_on:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "(vconst_on A c) \<restriction>\<^sup>r\<^sub>\<circ> B = vconst_on A c"
	using assms by auto

	lemma vrrestriction_vcomp[simp]: "(r \<circ>\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<circ> A = (r \<restriction>\<^sup>r\<^sub>\<circ> A) \<circ>\<^sub>\<circ> s" by auto


	text\<open>Previous connections.\<close>

	lemma vcomp_vid_on_rel[simp]: "vid_on A \<circ>\<^sub>\<circ> r = r \<restriction>\<^sup>r\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma vcomp_vconst_on_rel: "(vconst_on A c) \<circ>\<^sub>\<circ> r = (vconst_on A c) \<circ>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	by auto

	lemma vlrestriction_vconverse: "r\<inverse>\<^sub>\<circ> \<restriction>\<^sup>l\<^sub>\<circ> A = (r \<restriction>\<^sup>r\<^sub>\<circ> A)\<inverse>\<^sub>\<circ>" by auto

	lemma vrrestriction_vconverse: "r\<inverse>\<^sub>\<circ> \<restriction>\<^sup>r\<^sub>\<circ> A = (r \<restriction>\<^sup>l\<^sub>\<circ> A)\<inverse>\<^sub>\<circ>" by auto


	text\<open>Special properties.\<close>

	lemma vrrestriction_vsubset_rel: "r \<restriction>\<^sup>r\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r" by auto

	lemma vrrestriction_vsubset_vpairs: "r \<restriction>\<^sup>r\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> vpairs r" by auto


	subsubsection\<open>Restriction\<close>

	definition vrestriction :: "V \<Rightarrow> V"
	where "vrestriction D =
	VLambda D (\<lambda>\<langle>r, A\<rangle>. set {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vrestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sub>\<circ>\<close> 80)
	where "r \<restriction>\<^sub>\<circ> A \<equiv> vrestriction (set {\<langle>r, A\<rangle>}) \<lparr>\<langle>r, A\<rangle>\<rparr>"

	lemma app_vrestriction_def:
	"r \<restriction>\<^sub>\<circ> A = set {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vrestriction_def by simp

	lemma vrestriction_small[simp]:
	"small {\<langle>a, b\<rangle> \| a b. a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> A \<and> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma vrestrictionI[intro!]:
	assumes "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D"
	shows "\<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sub>\<circ> A\<rangle> \<in>\<^sub>\<circ> vrestriction D"
	using assms unfolding vrestriction_def by (simp add: VLambda_iff2)

	lemma vrestrictionD[dest]:
	assumes "\<langle>\<langle>r, A\<rangle>, s\<rangle> \<in>\<^sub>\<circ> vrestriction D"
	shows "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D" and "s = r \<restriction>\<^sub>\<circ> A"
	using assms unfolding vrestriction_def by auto

	lemma vrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> vrestriction D" and "D \<subseteq>\<^sub>\<circ> R \<times>\<^sub>\<circ> X"
	obtains r A where "x = \<langle>\<langle>r, A\<rangle>, r \<restriction>\<^sub>\<circ> A\<rangle>" and "r \<in>\<^sub>\<circ> R" and "A \<in>\<^sub>\<circ> X"
	using assms unfolding vrestriction_def by auto

	lemma app_vrestrictionI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<circ> A"
	using assms unfolding vrestriction_def by simp

	lemma app_vrestrictionD[dest]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrestriction_def by auto

	lemma app_vrestrictionE[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrestriction_def by clarsimp


	text\<open>Set operations.\<close>

	lemma vrestriction_on_vempty[simp]: "r \<restriction>\<^sub>\<circ> 0 = 0"
	by (auto intro!: vsubset_antisym)

	lemma vrestriction_vempty[simp]: "0 \<restriction>\<^sub>\<circ> A = 0" by auto

	lemma vrestriction_vsingleton_in[simp]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sub>\<circ> A = set {\<langle>a, b\<rangle>}"
	using assms by auto

	lemma vrestriction_vsingleton_nin_left[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vrestriction_vsingleton_nin_right[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} \<restriction>\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vrestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sub>\<circ> B"
	using assms by auto

	lemma vrestriction_vinsert_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A" and "b \<notin>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A"
	using assms by auto

	lemma vrestriction_vinsert_in:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "(vinsert \<langle>a, b\<rangle> r) \<restriction>\<^sub>\<circ> A = vinsert \<langle>a, b\<rangle> (r \<restriction>\<^sub>\<circ> A)"
	using assms by auto

	lemma vrestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A \<inter>\<^sub>\<circ> s \<restriction>\<^sub>\<circ> A" by auto

	lemma vrestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A \<union>\<^sub>\<circ> s \<restriction>\<^sub>\<circ> A" by auto

	lemma vrestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A -\<^sub>\<circ> s \<restriction>\<^sub>\<circ> A" by auto


	text\<open>Connections.\<close>

	lemma vrestriction_vid_on[simp]: "(vid_on A) \<restriction>\<^sub>\<circ> B = vid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma vrestriction_vconst_on_ex:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "(vconst_on A c) \<restriction>\<^sub>\<circ> B = vconst_on (A \<inter>\<^sub>\<circ> B) c"
	using assms by auto

	lemma vrestriction_vconst_on_nex:
	assumes "c \<notin>\<^sub>\<circ> B"
	shows "(vconst_on A c) \<restriction>\<^sub>\<circ> B = 0"
	using assms by auto

	lemma vrestriction_vcomp[simp]: "(r \<circ>\<^sub>\<circ> s) \<restriction>\<^sub>\<circ> A = (r \<restriction>\<^sup>r\<^sub>\<circ> A) \<circ>\<^sub>\<circ> (s \<restriction>\<^sup>l\<^sub>\<circ> A)" by auto

	lemma vrestriction_vconverse: "r\<inverse>\<^sub>\<circ> \<restriction>\<^sub>\<circ> A = (r \<restriction>\<^sub>\<circ> A)\<inverse>\<^sub>\<circ>" by auto


	text\<open>Previous connections.\<close>

	lemma vrrestriction_vlrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<circ> A) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A" by auto

	lemma vlrestriction_vrrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<circ> A) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A" by auto

	lemma vrestriction_vlrestriction[simp]: "(r \<restriction>\<^sub>\<circ> A) \<restriction>\<^sup>l\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A" by auto

	lemma vrestriction_vrrestriction[simp]: "(r \<restriction>\<^sub>\<circ> A) \<restriction>\<^sup>r\<^sub>\<circ> A = r \<restriction>\<^sub>\<circ> A" by auto


	text\<open>Special properties.\<close>

	lemma vrestriction_vsubset_vpairs: "r \<restriction>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> vpairs r" by auto

	lemma vrestriction_vsubset_vtimes: "r \<restriction>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> A" by auto

	lemma vrestriction_vsubset_rel: "r \<restriction>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r" by auto



	subsection\<open>Properties\<close>


	subsubsection\<open>Domain\<close>

	definition vdomain :: "V \<Rightarrow> V"
	where "vdomain D = (\<lambda>r\<in>\<^sub>\<circ>D. set {a. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vdomain :: "V \<Rightarrow> V" (\<open>\<D>\<^sub>\<circ>\<close>)
	where "\<D>\<^sub>\<circ> r \<equiv> vdomain (set {r}) \<lparr>r\<rparr>"

	lemma app_vdomain_def: "\<D>\<^sub>\<circ> r = set {a. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vdomain_def by simp

	lemma vdomain_small[simp]: "small {a. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{a. \<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} \<subseteq> vfst ` elts r" using image_iff by fastforce
	have small: "small (vfst ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma vdomainI[intro!]:
	assumes "r \<in>\<^sub>\<circ> A"
	shows "\<langle>r, \<D>\<^sub>\<circ> r\<rangle> \<in>\<^sub>\<circ> vdomain A"
	using assms unfolding vdomain_def by auto

	lemma vdomainD[dest]:
	assumes "\<langle>r, s\<rangle> \<in>\<^sub>\<circ> vdomain A"
	shows "r \<in>\<^sub>\<circ> A" and "s = \<D>\<^sub>\<circ> r"
	using assms unfolding vdomain_def by auto

	lemma vdomainE[elim]:
	assumes "x \<in>\<^sub>\<circ> vdomain A"
	obtains r where "x = \<langle>r, \<D>\<^sub>\<circ> r\<rangle>" and "r \<in>\<^sub>\<circ> A"
	using assms unfolding vdomain_def by auto

	lemma app_vdomainI[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	using assms unfolding vdomain_def by auto

	lemma app_vdomainD[dest]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "\<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vdomain_def by auto

	lemma app_vdomainE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	obtains b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vdomain_def by clarsimp

	lemma vdomain_iff: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<longleftrightarrow> (\<exists>y. \<langle>a, y\<rangle> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma vdomain_vempty[simp]: "\<D>\<^sub>\<circ> 0 = 0" by (auto intro!: vsubset_antisym)

	lemma vdomain_vsingleton[simp]: "\<D>\<^sub>\<circ> (set {\<langle>a, b\<rangle>}) = set {a}" by auto

	lemma vdomain_vdoubleton[simp]: "\<D>\<^sub>\<circ> (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>}) = set {a, c}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vdomain_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	using assms by blast

	lemma vdomain_vinsert[simp]: "\<D>\<^sub>\<circ> (vinsert \<langle>a, b\<rangle> r) = vinsert a (\<D>\<^sub>\<circ> r)"
	by (auto intro!: vsubset_antisym)

	lemma vdomain_vunion: "\<D>\<^sub>\<circ> (A \<union>\<^sub>\<circ> B) = \<D>\<^sub>\<circ> A \<union>\<^sub>\<circ> \<D>\<^sub>\<circ> B"
	by (auto intro!: vsubset_antisym)

	lemma vdomain_vintersection_vsubset: "\<D>\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> A \<inter>\<^sub>\<circ> \<D>\<^sub>\<circ> B" by auto

	lemma vdomain_vdiff_vsubset: "\<D>\<^sub>\<circ> A -\<^sub>\<circ> \<D>\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (A -\<^sub>\<circ> B)" by auto


	text\<open>Connections.\<close>

	lemma vdomain_vid_on[simp]: "\<D>\<^sub>\<circ> (vid_on A) = A"
	by (auto intro!: vsubset_antisym)

	lemma vdomain_vconst_on[simp]: "\<D>\<^sub>\<circ> (vconst_on A c) = A"
	by (auto intro!: vsubset_antisym)

	lemma vdomain_VLambda[simp]: "\<D>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a) = A"
	by (auto intro!: vsubset_antisym)

	lemma vdomain_vlrestriction: "\<D>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A) = \<D>\<^sub>\<circ> r \<inter>\<^sub>\<circ> A" by auto

	+lemma vdomain_vlrestriction_vsubset:
	+ assumes "A \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	+ shows "\<D>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A) = A"
	+ using assms by (auto simp: vdomain_vlrestriction)
	+

	text\<open>Special properties.\<close>

	lemma vdomain_vsubset_vtimes:
	assumes "vpairs r \<subseteq>\<^sub>\<circ> x \<times>\<^sub>\<circ> y"
	shows "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> x"
	using assms by auto


	subsubsection\<open>Range\<close>

	definition vrange :: "V \<Rightarrow> V"
	where "vrange D = (\<lambda>r\<in>\<^sub>\<circ>D. set {b. \<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r})"

	abbreviation app_vrange :: "V \<Rightarrow> V" (\<open>\<R>\<^sub>\<circ>\<close>)
	where "\<R>\<^sub>\<circ> r \<equiv> vrange (set {r}) \<lparr>r\<rparr>"

	lemma app_vrange_def: "\<R>\<^sub>\<circ> r = set {b. \<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vrange_def by simp

	lemma vrange_small[simp]: "small {b. \<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{b. \<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} \<subseteq> vsnd ` elts r" using image_iff by fastforce
	have small: "small (vsnd ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma vrangeI[intro]:
	assumes "r \<in>\<^sub>\<circ> A"
	shows "\<langle>r, \<R>\<^sub>\<circ> r\<rangle> \<in>\<^sub>\<circ> vrange A"
	using assms unfolding vrange_def by auto

	lemma vrangeD[dest]:
	assumes "\<langle>r, s\<rangle> \<in>\<^sub>\<circ> vrange A"
	shows "r \<in>\<^sub>\<circ> A" and "s = \<R>\<^sub>\<circ> r"
	using assms unfolding vrange_def by auto

	lemma vrangeE[elim]:
	assumes "x \<in>\<^sub>\<circ> vrange A"
	obtains r where "x = \<langle>r, \<R>\<^sub>\<circ> r\<rangle>" and "r \<in>\<^sub>\<circ> A"
	using assms unfolding vrange_def by auto

	lemma app_vrangeI[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms unfolding vrange_def by auto

	lemma app_vrangeD[dest]:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "\<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrange_def by simp

	lemma app_vrangeE[elim]:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	obtains a where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vrange_def by clarsimp

	lemma vrange_iff: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<longleftrightarrow> (\<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma vrange_vempty[simp]: "\<R>\<^sub>\<circ> 0 = 0" by (auto intro!: vsubset_antisym)

	lemma vrange_vsingleton[simp]: "\<R>\<^sub>\<circ> (set {\<langle>a, b\<rangle>}) = set {b}" by auto

	lemma vrange_vdoubleton[simp]: "\<R>\<^sub>\<circ> (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>}) = set {b, d}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vrange_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> s"
	using assms by force

	lemma vrange_vinsert[simp]: "\<R>\<^sub>\<circ> (vinsert \<langle>a, b\<rangle> r) = vinsert b (\<R>\<^sub>\<circ> r)"
	by (auto intro!: vsubset_antisym)

	lemma vrange_vunion: "\<R>\<^sub>\<circ> (r \<union>\<^sub>\<circ> s) = \<R>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> s"
	by (auto intro!: vsubset_antisym)

	lemma vrange_vintersection_vsubset: "\<R>\<^sub>\<circ> (r \<inter>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<inter>\<^sub>\<circ> \<R>\<^sub>\<circ> s" by auto

	lemma vrange_vdiff_vsubset: "\<R>\<^sub>\<circ> r -\<^sub>\<circ> \<R>\<^sub>\<circ> s \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (r -\<^sub>\<circ> s)" by auto


	text\<open>Connections.\<close>

	lemma vrange_vid_on[simp]: "\<R>\<^sub>\<circ> (vid_on A) = A" by (auto intro!: vsubset_antisym)

	lemma vrange_vconst_on_vempty[simp]: "\<R>\<^sub>\<circ> (vconst_on 0 c) = 0" by auto

	lemma vrange_vconst_on_ne[simp]:
	assumes "A \<noteq> 0"
	shows "\<R>\<^sub>\<circ> (vconst_on A c) = set {c}"
	using assms by (auto intro!: vsubset_antisym)

	lemma vrange_VLambda: "\<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a) = set (f ` elts A)"
	by (intro vsubset_antisym vsubsetI) auto

	lemma vrange_vrrestriction: "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A) = \<R>\<^sub>\<circ> r \<inter>\<^sub>\<circ> A" by auto


	text\<open>Previous connections\<close>

	lemma vdomain_vconverse[simp]: "\<D>\<^sub>\<circ> (r\<inverse>\<^sub>\<circ>) = \<R>\<^sub>\<circ> r"
	by (auto intro!: vsubset_antisym)

	lemma vrange_vconverse[simp]: "\<R>\<^sub>\<circ> (r\<inverse>\<^sub>\<circ>) = \<D>\<^sub>\<circ> r"
	by (auto intro!: vsubset_antisym)


	text\<open>Special properties.\<close>

	lemma vrange_iff_vdomain: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> r. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r)" by auto

	lemma vrange_vsubset_vtimes:
	assumes "vpairs r \<subseteq>\<^sub>\<circ> x \<times>\<^sub>\<circ> y"
	shows "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> y"
	using assms by auto

	lemma vrange_VLambda_vsubset:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> f x \<in>\<^sub>\<circ> B"
	shows "\<R>\<^sub>\<circ> (VLambda A f) \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vpairs_vsubset_vdomain_vrange[simp]: "vpairs r \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	by (rule vsubsetI) auto

	lemma vrange_vsubset:
	assumes "\<And>x y. \<langle>x, y\<rangle> \<in>\<^sub>\<circ> r \<Longrightarrow> y \<in>\<^sub>\<circ> A"
	shows "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A"
	using assms by auto


	subsubsection\<open>Field\<close>

	definition vfield :: "V \<Rightarrow> V"
	where "vfield D = (\<lambda>r\<in>\<^sub>\<circ>D. \<D>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> r)"

	abbreviation app_vfield :: "V \<Rightarrow> V" (\<open>\<F>\<^sub>\<circ>\<close>)
	where "\<F>\<^sub>\<circ> r \<equiv> vfield (set {r}) \<lparr>r\<rparr>"

	lemma app_vfield_def: "\<F>\<^sub>\<circ> r = \<D>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> r" unfolding vfield_def by simp


	text\<open>Rules.\<close>

	lemma vfieldI[intro!]:
	assumes "r \<in>\<^sub>\<circ> A"
	shows "\<langle>r, \<F>\<^sub>\<circ> r\<rangle> \<in>\<^sub>\<circ> vfield A"
	using assms unfolding vfield_def by auto

	lemma vfieldD[dest]:
	assumes "\<langle>r, s\<rangle> \<in>\<^sub>\<circ> vfield A"
	shows "r \<in>\<^sub>\<circ> A" and "s = \<F>\<^sub>\<circ> r"
	using assms unfolding vfield_def by auto

	lemma vfieldE[elim]:
	assumes "x \<in>\<^sub>\<circ> vfield A"
	obtains r where "x = \<langle>r, \<F>\<^sub>\<circ> r\<rangle>" and "r \<in>\<^sub>\<circ> A"
	using assms unfolding vfield_def by auto

	lemma app_vfieldI1[intro]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	using assms unfolding vfield_def by simp

	lemma app_vfieldI2[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	using assms by auto

	lemma app_vfieldI3[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "b \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	using assms by auto

	lemma app_vfieldD[dest]:
	assumes "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms unfolding vfield_def by simp

	lemma app_vfieldE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<Longrightarrow> P"
	shows P
	using assms by auto

	lemma app_vfield_vpairE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	obtains b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<or> \<langle>b, a\<rangle> \<in>\<^sub>\<circ> r "
	using assms unfolding app_vfield_def by blast

	lemma vfield_iff: "a \<in>\<^sub>\<circ> \<F>\<^sub>\<circ> r \<longleftrightarrow> (\<exists>b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<or> \<langle>b, a\<rangle> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma vfield_vempty[simp]: "\<F>\<^sub>\<circ> 0 = 0" by (auto intro!: vsubset_antisym)

	lemma vfield_vsingleton[simp]: "\<F>\<^sub>\<circ> (set {\<langle>a, b\<rangle>}) = set {a, b}"
	by (simp add: app_vfield_def vinsert_set_insert_eq)

	lemma vfield_vdoubleton[simp]: "\<F>\<^sub>\<circ> (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>}) = set {a, b, c, d}"
	by (auto simp: vinsert_set_insert_eq)

	lemma vfield_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "\<F>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<F>\<^sub>\<circ> s"
	using assms by fastforce

	lemma vfield_vinsert[simp]: "\<F>\<^sub>\<circ> (vinsert \<langle>a, b\<rangle> r) = set {a, b} \<union>\<^sub>\<circ> \<F>\<^sub>\<circ> r"
	by (auto intro!: vsubset_antisym)

	lemma vfield_vunion[simp]: "\<F>\<^sub>\<circ> (r \<union>\<^sub>\<circ> s) = \<F>\<^sub>\<circ> r \<union>\<^sub>\<circ> \<F>\<^sub>\<circ> s"
	by (auto intro!: vsubset_antisym)


	text\<open>Connections.\<close>

	lemma vid_on_vfield[simp]: "\<F>\<^sub>\<circ> (vid_on A) = A" by (auto intro!: vsubset_antisym)

	lemma vconst_on_vfield_ne[intro, simp]:
	assumes "A \<noteq> 0"
	shows "\<F>\<^sub>\<circ> (vconst_on A c) = vinsert c A"
	using assms by (auto intro!: vsubset_antisym)

	lemma vconst_on_vfield_vempty[simp]: "\<F>\<^sub>\<circ> (vconst_on 0 c) = 0" by auto

	lemma vfield_vconverse[simp]: "\<F>\<^sub>\<circ> (r\<inverse>\<^sub>\<circ>) = \<F>\<^sub>\<circ> r"
	by (auto intro!: vsubset_antisym)


	subsubsection\<open>Image\<close>

	definition vimage :: "V \<Rightarrow> V"
	where "vimage D = VLambda D (\<lambda>\<langle>r, A\<rangle>. \<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A))"

	abbreviation app_vimage :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>`\<^sub>\<circ>\<close> 90)
	where "r `\<^sub>\<circ> A \<equiv> vimage (set {\<langle>r, A\<rangle>}) \<lparr>\<langle>r, A\<rangle>\<rparr>"

	lemma app_vimage_def: "r `\<^sub>\<circ> A = \<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A)" unfolding vimage_def by simp

	lemma vimage_small[simp]: "small {b. \<exists>a\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{b. \<exists>a\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} \<subseteq> vsnd ` elts r"
	using image_iff by fastforce
	have small: "small (vsnd ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed

	lemma app_vimage_set_def: "r `\<^sub>\<circ> A = set {b. \<exists>a\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	unfolding vimage_def vrange_def by auto


	text\<open>Rules.\<close>

	lemma vimageI[intro!]:
	assumes "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D"
	shows "\<langle>\<langle>r, A\<rangle>, r `\<^sub>\<circ> A\<rangle> \<in>\<^sub>\<circ> vimage D"
	using assms unfolding vimage_def by (simp add: VLambda_iff2)

	lemma vimageD[dest]:
	assumes "\<langle>\<langle>r, A\<rangle>, s\<rangle> \<in>\<^sub>\<circ> vimage D"
	shows "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D" and "s = r `\<^sub>\<circ> A"
	using assms unfolding vimage_def by auto

	lemma vimageE[elim]:
	assumes "x \<in>\<^sub>\<circ> vimage (R \<times>\<^sub>\<circ> X)"
	obtains r A where "x = \<langle>\<langle>r, A\<rangle>, r `\<^sub>\<circ> A\<rangle>" and "r \<in>\<^sub>\<circ> R" and "A \<in>\<^sub>\<circ> X"
	using assms unfolding vimage_def by auto

	lemma app_vimageI1:
	assumes "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	shows "x \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	using assms unfolding vimage_def by simp

	lemma app_vimageI2[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	using assms app_vimageI1 by auto

	lemma app_vimageD[dest]:
	assumes "x \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	shows "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using assms unfolding vimage_def by simp

	lemma app_vimageE[elim]:
	assumes "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	obtains a where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	using assms unfolding vimage_def by auto

	lemma app_vimage_iff: "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma vimage_vempty[simp]: "0 `\<^sub>\<circ> A = 0" by (auto intro!: vsubset_antisym)

	lemma vimage_of_vempty[simp]: "r `\<^sub>\<circ> 0 = 0" by (auto intro!: vsubset_antisym)

	lemma vimage_vsingleton: "r `\<^sub>\<circ> set {a} = set {b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have "{b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} \<subseteq> {b. \<exists>a. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}" by auto
	then have [simp]: "small {b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule smaller_than_small[OF vrange_small[of r]])
	show ?thesis using app_vimage_set_def by auto
	qed

	lemma vimage_vsingleton_in[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} `\<^sub>\<circ> A = set {b}"
	using assms by auto

	lemma vimage_vsingleton_nin[intro, simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} `\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vimage_vsingleton_vinsert[simp]: "set {\<langle>a, b\<rangle>} `\<^sub>\<circ> vinsert a A = set {b}"
	by auto

	lemma vimage_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "A' \<subseteq>\<^sub>\<circ> A"
	shows "(r' `\<^sub>\<circ> A') \<subseteq>\<^sub>\<circ> (r `\<^sub>\<circ> A)"
	using assms by fastforce

	lemma vimage_vinsert: "r `\<^sub>\<circ> (vinsert a A) = r `\<^sub>\<circ> set {a} \<union>\<^sub>\<circ> r `\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vunion_left: "(r \<union>\<^sub>\<circ> s) `\<^sub>\<circ> A = r `\<^sub>\<circ> A \<union>\<^sub>\<circ> s `\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vunion_right: "r `\<^sub>\<circ> (A \<union>\<^sub>\<circ> B) = r `\<^sub>\<circ> A \<union>\<^sub>\<circ> r `\<^sub>\<circ> B"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vintersection: "r `\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> r `\<^sub>\<circ> A \<inter>\<^sub>\<circ> r `\<^sub>\<circ> B" by auto

	lemma vimage_vdiff: "r `\<^sub>\<circ> A -\<^sub>\<circ> r `\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> r `\<^sub>\<circ> (A -\<^sub>\<circ> B)" by auto


	text\<open>Previous set operations.\<close>

	lemma VPow_vinsert:
	"VPow (vinsert a A) = VPow A \<union>\<^sub>\<circ> ((\<lambda>x\<in>\<^sub>\<circ>VPow A. vinsert a x) `\<^sub>\<circ> VPow A)"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> VPow (vinsert a A)"
	then have "x \<subseteq>\<^sub>\<circ> vinsert a A" by simp
	then consider "x \<subseteq>\<^sub>\<circ> A" \| "a \<in>\<^sub>\<circ> x" by auto
	then show "x \<in>\<^sub>\<circ> VPow A \<union>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>VPow A. vinsert a x) `\<^sub>\<circ> VPow A"
	proof cases
	case 1 then show ?thesis by simp
	next
	case 2
	define x' where "x' = x -\<^sub>\<circ> set {a}"
	with 2 have "x = vinsert a x'" and "a \<notin>\<^sub>\<circ> x'" by auto
	with \<open>x \<subseteq>\<^sub>\<circ> vinsert a A\<close> show ?thesis
	unfolding vimage_def
	by (fastforce simp: vsubset_vinsert vlrestriction_VLambda)
	qed
	qed (elim vunionE, auto)


	text\<open>Special properties.\<close>

	lemma vimage_vsingleton_iff[iff]: "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> set {a} \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto

	lemma vimage_is_vempty[iff]: "r `\<^sub>\<circ> A = 0 \<longleftrightarrow> vdisjnt (\<D>\<^sub>\<circ> r) A" by fastforce

	lemma vcomp_vimage_vtimes_right:
	assumes "r `\<^sub>\<circ> Y = Z"
	shows "r \<circ>\<^sub>\<circ> (X \<times>\<^sub>\<circ> Y) = X \<times>\<^sub>\<circ> Z"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume x: "x \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> (X \<times>\<^sub>\<circ> Y)"
	then obtain a c where x_def: "x = \<langle>a, c\<rangle>" and "a \<in>\<^sub>\<circ> X" and "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	with x obtain b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> X \<times>\<^sub>\<circ> Y" and "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r" by clarsimp
	then show "x \<in>\<^sub>\<circ> X \<times>\<^sub>\<circ> Z" unfolding x_def using assms by auto
	next
	fix x assume "x \<in>\<^sub>\<circ> X \<times>\<^sub>\<circ> Z"
	then obtain a c where x_def: "x = \<langle>a, c\<rangle>" and "a \<in>\<^sub>\<circ> X" and "c \<in>\<^sub>\<circ> Z" by auto
	then show "x \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> X \<times>\<^sub>\<circ> Y"
	using assms unfolding x_def by (meson VSigmaI app_vimageE vcompI)
	qed


	text\<open>Connections.\<close>

	lemma vid_on_vimage[simp]: "vid_on A `\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> B"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vconst_on_ne[simp]:
	assumes "B \<inter>\<^sub>\<circ> A \<noteq> 0"
	shows "vconst_on A c `\<^sub>\<circ> B = set {c}"
	using assms by auto

	lemma vimage_vconst_on_vempty[simp]:
	assumes "vdisjnt A B"
	shows "vconst_on A c `\<^sub>\<circ> B = 0"
	using assms by auto

	lemma vimage_vconst_on_vsubset_vconst: "vconst_on A c `\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> set {c}" by auto

	lemma vimage_VLambda_vrange: "(\<lambda>a\<in>\<^sub>\<circ>A. f a) `\<^sub>\<circ> B = \<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> B. f a)"
	unfolding vimage_def by (simp add: vlrestriction_VLambda)

	lemma vimage_VLambda_vrange_rep: "(\<lambda>a\<in>\<^sub>\<circ>A. f a) `\<^sub>\<circ> A = \<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	by (simp add: vimage_VLambda_vrange)

	lemma vcomp_vimage: "(r \<circ>\<^sub>\<circ> s) `\<^sub>\<circ> A = r `\<^sub>\<circ> (s `\<^sub>\<circ> A)"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vlrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<circ> A) `\<^sub>\<circ> B = r `\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B)"
	by (auto intro!: vsubset_antisym)

	lemma vimage_vrrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<circ> A) `\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> r `\<^sub>\<circ> B" by auto

	lemma vimage_vrestriction[simp]: "(r \<restriction>\<^sub>\<circ> A) `\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> (r `\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B))" by auto

	lemma vimage_vdomain: "r `\<^sub>\<circ> \<D>\<^sub>\<circ> r = \<R>\<^sub>\<circ> r" by (auto intro!: vsubset_antisym)

	lemma vimage_eq_imp_vcomp:
	assumes "r `\<^sub>\<circ> A = s `\<^sub>\<circ> B"
	shows "(t \<circ>\<^sub>\<circ> r) `\<^sub>\<circ> A = (t \<circ>\<^sub>\<circ> s) `\<^sub>\<circ> B"
	using assms by (metis vcomp_vimage)


	text\<open>Previous connections.\<close>

	lemma vcomp_rel_vconst: "r \<circ>\<^sub>\<circ> (vconst_on A c) = A \<times>\<^sub>\<circ> (r `\<^sub>\<circ> set {c})"
	by auto

	lemma vcomp_VLambda:
	"(\<lambda>b\<in>\<^sub>\<circ>((\<lambda>a\<in>\<^sub>\<circ>A. g a) `\<^sub>\<circ> A). f b) \<circ>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. g a) = (\<lambda>a\<in>\<^sub>\<circ>A. (f \<circ> g) a)"
	using VLambda_iff1 by (auto intro!: vsubset_antisym)+


	text\<open>Further special properties.\<close>

	lemma vimage_vsubset:
	assumes "r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	shows "r `\<^sub>\<circ> C \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vimage_vdomain_vsubset: "r `\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> r `\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto

	lemma vdomain_vsubset_VUnion2: "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	then obtain y where "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> r" by auto
	then have "set {set {x}, set {x, y}} \<in>\<^sub>\<circ> r" unfolding vpair_def by auto
	with insert_commute have xy_Ur: "set {x, y} \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>r"
	unfolding VUnion_iff by auto
	define Ur where "Ur = \<Union>\<^sub>\<circ>r"
	from xy_Ur show "x \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)"
	unfolding Ur_def[symmetric] by (auto dest: VUnionI)
	qed

	lemma vrange_vsubset_VUnion2: "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	then obtain x where "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> r" by auto
	then have "set {set {x}, set {x, y}} \<in>\<^sub>\<circ> r" unfolding vpair_def by auto
	with insert_commute have xy_Ur: "set {x, y} \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>r"
	unfolding VUnion_iff by auto
	define Ur where "Ur = \<Union>\<^sub>\<circ>r"
	from xy_Ur show "y \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)"
	unfolding Ur_def[symmetric] by (auto dest: VUnionI)
	qed

	lemma vfield_vsubset_VUnion2: "\<F>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)"
	using vdomain_vsubset_VUnion2 vrange_vsubset_VUnion2
	by (auto simp: app_vfield_def)


	subsubsection\<open>Inverse image\<close>

	definition invimage :: "V \<Rightarrow> V"
	where "invimage D = VLambda D (\<lambda>\<langle>r, A\<rangle>. r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A)"

	abbreviation app_invimage :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>-`\<^sub>\<circ>\<close> 90)
	where "r -`\<^sub>\<circ> A \<equiv> invimage (set {\<langle>r, A\<rangle>}) \<lparr>\<langle>r, A\<rangle>\<rparr>"

	lemma app_invimage_def: "r -`\<^sub>\<circ> A = r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A" unfolding invimage_def by simp

	lemma invimage_small[simp]: "small {a. \<exists>b\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{a. \<exists>b\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r} \<subseteq> vfst ` elts r"
	using image_iff by fastforce
	have small: "small (vfst ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma invimageI[intro!]:
	assumes "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D"
	shows "\<langle>\<langle>r, A\<rangle>, r -`\<^sub>\<circ> A\<rangle> \<in>\<^sub>\<circ> invimage D"
	using assms unfolding invimage_def by (simp add: VLambda_iff2)

	lemma invimageD[dest]:
	assumes "\<langle>\<langle>r, A\<rangle>, s\<rangle> \<in>\<^sub>\<circ> invimage D"
	shows "\<langle>r, A\<rangle> \<in>\<^sub>\<circ> D" and "s = r -`\<^sub>\<circ> A"
	using assms unfolding invimage_def by auto

	lemma invimageE[elim]:
	assumes "x \<in>\<^sub>\<circ> invimage D" and "D \<subseteq>\<^sub>\<circ> R \<times>\<^sub>\<circ> X"
	obtains r A where "x = \<langle>\<langle>r, A\<rangle>, r -`\<^sub>\<circ> A\<rangle>" and "r \<in>\<^sub>\<circ> R" and "A \<in>\<^sub>\<circ> X"
	using assms unfolding invimage_def by auto

	lemma app_invimageI[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	using assms invimage_def by auto

	lemma app_invimageD[dest]:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	using assms using invimage_def by auto

	lemma app_invimageE[elim]:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	obtains b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A"
	using assms unfolding invimage_def by auto

	lemma app_invimageI1:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	using assms unfolding vimage_def
	by (simp add: invimage_def app_vimageI1 vlrestriction_vconverse)

	lemma app_invimageD1:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	using assms by fastforce

	lemma app_invimageE1:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A " and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A) \<Longrightarrow> P"
	shows P
	using assms unfolding invimage_def by auto

	lemma app_invimageI2:
	assumes "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	using assms unfolding invimage_def by simp

	lemma app_invimageD2:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A"
	using assms unfolding invimage_def by simp

	lemma app_invimageE2:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A" and "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A \<Longrightarrow> P"
	shows P
	unfolding vimage_def by (simp add: assms app_invimageD2)

	lemma invimage_iff: "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A \<longleftrightarrow> (\<exists>b\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r)" by auto

	lemma invimage_iff1: "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A \<longleftrightarrow> a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)" by auto

	lemma invimage_iff2: "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A \<longleftrightarrow> a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A" by auto


	text\<open>Set operations.\<close>

	lemma invimage_vempty[simp]: "0 -`\<^sub>\<circ> A = 0" by (auto intro!: vsubset_antisym)

	lemma invimage_of_vempty[simp]: "r -`\<^sub>\<circ> 0 = 0" by (auto intro!: vsubset_antisym)

	lemma invimage_vsingleton_in[intro, simp]:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} -`\<^sub>\<circ> A = set {a}"
	using assms by auto

	lemma invimage_vsingleton_nin[intro, simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {\<langle>a, b\<rangle>} -`\<^sub>\<circ> A = 0"
	using assms by auto

	lemma invimage_vsingleton_vinsert[intro, simp]:
	"set {\<langle>a, b\<rangle>} -`\<^sub>\<circ> vinsert b A = set {a}"
	by auto

	lemma invimage_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "A' \<subseteq>\<^sub>\<circ> A"
	shows "(r' -`\<^sub>\<circ> A') \<subseteq>\<^sub>\<circ> (r -`\<^sub>\<circ> A)"
	using assms by fastforce

	lemma invimage_vinsert: "r -`\<^sub>\<circ> (vinsert a A) = r -`\<^sub>\<circ> set {a} \<union>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vunion_left: "(r \<union>\<^sub>\<circ> s) -`\<^sub>\<circ> A = r -`\<^sub>\<circ> A \<union>\<^sub>\<circ> s -`\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vunion_right: "r -`\<^sub>\<circ> (A \<union>\<^sub>\<circ> B) = r -`\<^sub>\<circ> A \<union>\<^sub>\<circ> r -`\<^sub>\<circ> B"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vintersection: "r -`\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> r -`\<^sub>\<circ> A \<inter>\<^sub>\<circ> r -`\<^sub>\<circ> B" by auto

	lemma invimage_vdiff: "r -`\<^sub>\<circ> A -\<^sub>\<circ> r -`\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> r -`\<^sub>\<circ> (A -\<^sub>\<circ> B)" by auto


	text\<open>Special properties.\<close>

	lemma invimage_set_def: "r -`\<^sub>\<circ> A = set {a. \<exists>b\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}" by fastforce

	lemma invimage_eq_vdomain_vrestriction: "r -`\<^sub>\<circ> A = \<D>\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<circ> A)" by fastforce

	lemma invimage_vrange[simp]: "r -`\<^sub>\<circ> \<R>\<^sub>\<circ> r = \<D>\<^sub>\<circ> r"
	unfolding invimage_def by (auto intro!: vsubset_antisym)

	lemma invimage_vrange_vsubset[simp]:
	assumes "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> B"
	shows "r -`\<^sub>\<circ> B = \<D>\<^sub>\<circ> r"
	using assms unfolding app_invimage_def by (blast intro!: vsubset_antisym)


	text\<open>Connections.\<close>

	lemma invimage_vid_on[simp]: "vid_on A -`\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> B"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vconst_on_vsubset_vdomain[simp]: "vconst_on A c -`\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> A"
	unfolding invimage_def by auto

	lemma invimage_vconst_on_ne[simp]:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "vconst_on A c -`\<^sub>\<circ> B = A"
	by (simp add: assms invimage_eq_vdomain_vrestriction vrrestriction_vconst_on)

	lemma invimage_vconst_on_vempty[simp]:
	assumes "c \<notin>\<^sub>\<circ> B"
	shows "vconst_on A c -`\<^sub>\<circ> B = 0"
	using assms by auto

	lemma invimage_vcomp: "(r \<circ>\<^sub>\<circ> s) -`\<^sub>\<circ> x = s -`\<^sub>\<circ> (r -`\<^sub>\<circ> x) "
	by (simp add: invimage_def vconverse_vcomp vcomp_vimage)

	lemma invimage_vconverse[simp]: "r\<inverse>\<^sub>\<circ> -`\<^sub>\<circ> A = r `\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vlrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<circ> A) -`\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> r -`\<^sub>\<circ> B" by auto

	lemma invimage_vrrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<circ> A) -`\<^sub>\<circ> B = (r -`\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B))"
	by (auto intro!: vsubset_antisym)

	lemma invimage_vrestriction[simp]: "(r \<restriction>\<^sub>\<circ> A) -`\<^sub>\<circ> B = A \<inter>\<^sub>\<circ> (r -`\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B))"
	by blast


	text\<open>Previous connections.\<close>

	lemma vcomp_vconst_on_rel_vtimes: "vconst_on A c \<circ>\<^sub>\<circ> r = (r -`\<^sub>\<circ> A) \<times>\<^sub>\<circ> set {c}"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A \<times>\<^sub>\<circ> set {c}"
	then obtain a where x_def: "x = \<langle>a, c\<rangle>" and "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A" by auto
	then obtain b where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A" using invimage_iff by auto
	with \<open>b \<in>\<^sub>\<circ> A\<close> show "x \<in>\<^sub>\<circ> vconst_on A c \<circ>\<^sub>\<circ> r" unfolding x_def by auto
	qed auto

	lemma vdomain_vcomp[simp]: "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) = s -`\<^sub>\<circ> \<D>\<^sub>\<circ> r" by blast

	lemma vrange_vcomp[simp]: "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) = r `\<^sub>\<circ> \<R>\<^sub>\<circ> s" by blast

	lemma vdomain_vcomp_vsubset:
	assumes "\<R>\<^sub>\<circ> s \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) = \<D>\<^sub>\<circ> s"
	using assms by simp



	subsection\<open>Classification of relations\<close>


	subsubsection\<open>Binary relation\<close>

	locale vbrelation =
	fixes r :: V
	assumes vbrelation: "vpairs r = r"


	text\<open>Rules.\<close>

	lemma vpairs_eqI[intro!]:
	assumes "\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = \<langle>a, b\<rangle>"
	shows "vpairs r = r"
	using assms by auto

	lemma vpairs_eqD[dest]:
	assumes "vpairs r = r"
	shows "\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = \<langle>a, b\<rangle>"
	using assms by auto

	lemma vpairs_eqE[elim!]:
	assumes "vpairs r = r" and "(\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = \<langle>a, b\<rangle>) \<Longrightarrow> P"
	shows P
	using assms by auto

	lemmas vbrelationI[intro!] = vbrelation.intro
	lemmas vbrelationD[dest!] = vbrelation.vbrelation

	lemma vbrelationE[elim!]:
	assumes "vbrelation r" and "(vpairs r = r) \<Longrightarrow> P"
	shows P
	using assms unfolding vbrelation_def by auto

	lemma vbrelationE1[elim]:
	assumes "vbrelation r" and "x \<in>\<^sub>\<circ> r"
	obtains a b where "x = \<langle>a, b\<rangle>"
	using assms by auto

	lemma vbrelationD1[dest]:
	assumes "vbrelation r" and "x \<in>\<^sub>\<circ> r"
	shows "\<exists>a b. x = \<langle>a, b\<rangle>"
	using assms by auto

	lemma (in vbrelation) vbrelation_vinE:
	assumes "x \<in>\<^sub>\<circ> r"
	obtains a b where "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms vbrelation_axioms by blast


	text\<open>Set operations.\<close>

	lemma vbrelation_vsubset:
	assumes "vbrelation s" and "r \<subseteq>\<^sub>\<circ> s"
	shows "vbrelation r"
	using assms by auto

	lemma vbrelation_vinsert[simp]: "vbrelation (vinsert \<langle>a, b\<rangle> r) \<longleftrightarrow> vbrelation r"
	by auto

	lemma (in vbrelation) vbrelation_vinsertI[intro, simp]:
	"vbrelation (vinsert \<langle>a, b\<rangle> r)"
	using vbrelation_axioms by auto

	lemma vbrelation_vinsertD[dest]:
	assumes "vbrelation (vinsert \<langle>a, b\<rangle> r)"
	shows "vbrelation r"
	using assms by auto

	lemma vbrelation_vunion: "vbrelation (r \<union>\<^sub>\<circ> s) \<longleftrightarrow> vbrelation r \<and> vbrelation s"
	by auto

	lemma vbrelation_vunionI:
	assumes "vbrelation r" and "vbrelation s"
	shows "vbrelation (r \<union>\<^sub>\<circ> s)"
	using assms by auto

	lemma vbrelation_vunionD[dest]:
	assumes "vbrelation (r \<union>\<^sub>\<circ> s)"
	shows "vbrelation r" and "vbrelation s"
	using assms by auto

	lemma (in vbrelation) vbrelation_vintersectionI: "vbrelation (r \<inter>\<^sub>\<circ> s)"
	using vbrelation_axioms by auto

	lemma (in vbrelation) vbrelation_vdiffI: "vbrelation (r -\<^sub>\<circ> s)"
	using vbrelation_axioms by auto


	text\<open>Connections.\<close>

	lemma vbrelation_vempty: "vbrelation 0" by auto

	lemma vbrelation_vsingleton: "vbrelation (set {\<langle>a, b\<rangle>})" by auto

	lemma vbrelation_vdoubleton: "vbrelation (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>})" by auto

	lemma vbrelation_vid_on[simp]: "vbrelation (vid_on A)" by auto

	lemma vbrelation_vconst_on[simp]: "vbrelation (vconst_on A c)" by auto

	lemma vbrelation_VLambda[simp]: "vbrelation (VLambda A f)"
	unfolding VLambda_def by (intro vbrelationI) auto

	global_interpretation rel_VLambda: vbrelation \<open>VLambda U f\<close>
	by (rule vbrelation_VLambda)

	lemma vbrelation_vcomp:
	assumes "vbrelation r" and "vbrelation s"
	shows "vbrelation (r \<circ>\<^sub>\<circ> s)"
	using assms by auto

	lemma (in vbrelation) vbrelation_vconverse: "vbrelation (r\<inverse>\<^sub>\<circ>)"
	using vbrelation_axioms by clarsimp

	lemma vbrelation_vlrestriction[intro, simp]: "vbrelation (r \<restriction>\<^sup>l\<^sub>\<circ> A)" by auto

	lemma vbrelation_vrrestriction[intro, simp]: "vbrelation (r \<restriction>\<^sup>r\<^sub>\<circ> A)" by auto

	lemma vbrelation_vrestriction[intro, simp]: "vbrelation (r \<restriction>\<^sub>\<circ> A)" by auto


	text\<open>Previous connections.\<close>

	lemma (in vbrelation) vconverse_vconverse[simp]: "(r\<inverse>\<^sub>\<circ>)\<inverse>\<^sub>\<circ> = r"
	using vbrelation_axioms by auto

	lemma vconverse_mono[simp]:
	assumes "vbrelation r" and "vbrelation s"
	shows "r\<inverse>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> s\<inverse>\<^sub>\<circ> \<longleftrightarrow> r \<subseteq>\<^sub>\<circ> s"
	using assms by (force intro: vconverse_vunion)+

	lemma vconverse_inject[simp]:
	assumes "vbrelation r" and "vbrelation s"
	shows "r\<inverse>\<^sub>\<circ> = s\<inverse>\<^sub>\<circ> \<longleftrightarrow> r = s"
	using assms by fast

	lemma (in vbrelation) vconverse_vsubset_swap_2:
	assumes "r\<inverse>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> s"
	shows "r \<subseteq>\<^sub>\<circ> s\<inverse>\<^sub>\<circ>"
	using assms vbrelation_axioms by auto

	lemma (in vbrelation) vlrestriction_vdomain[simp]: "r \<restriction>\<^sup>l\<^sub>\<circ> \<D>\<^sub>\<circ> r = r"
	using vbrelation_axioms by (elim vbrelationE) auto

	lemma (in vbrelation) vrrestriction_vrange[simp]: "r \<restriction>\<^sup>r\<^sub>\<circ> \<R>\<^sub>\<circ> r = r"
	using vbrelation_axioms by (elim vbrelationE) auto


	text\<open>Special properties.\<close>

	lemma brel_vsubset_vtimes:
	"vbrelation r \<longleftrightarrow> r \<subseteq>\<^sub>\<circ> set (vfst ` elts r) \<times>\<^sub>\<circ> set (vsnd ` elts r)"
	by force

	lemma vsubset_vtimes_vbrelation:
	assumes "r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	shows "vbrelation r"
	using assms by auto

	lemma (in vbrelation) vbrelation_vintersection_vdomain:
	assumes "vdisjnt (\<D>\<^sub>\<circ> r) (\<D>\<^sub>\<circ> s)"
	shows "vdisjnt r s"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis vbrelationE1 vbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed simp

	lemma (in vbrelation) vbrelation_vintersection_vrange:
	assumes "vdisjnt (\<R>\<^sub>\<circ> r) (\<R>\<^sub>\<circ> s)"
	shows "vdisjnt r s"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis vbrelationE1 vbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed simp

	lemma (in vbrelation) vbrelation_vintersection_vfield:
	assumes "vdisjnt (vfield r) (vfield s)"
	shows "vdisjnt r s"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis vbrelationE1 vbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed auto

	lemma (in vbrelation) vdomain_vrange_vtimes: "r \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<times>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using vbrelation by auto

	lemma (in vbrelation) vbrelation_vsubset_vtimes:
	assumes "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A" and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> B"
	shows "r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	proof(intro vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> r"
	with vbrelation obtain a b where x_def: "x = \<langle>a, b\<rangle>" by auto
	from prems have a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and b: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" unfolding x_def by auto
	with assms have "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B" by auto
	then show "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B" unfolding x_def by simp
	qed

	lemma (in vbrelation) vlrestriction_vsubset_vrange[intro, simp]:
	assumes "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A"
	shows "r \<restriction>\<^sup>l\<^sub>\<circ> A = r"
	proof(intro vsubset_antisym)
	show "r \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> A"
	by (rule vlrestriction_mono[OF assms, of r, unfolded vlrestriction_vdomain])
	qed auto

	lemma (in vbrelation) vrrestriction_vsubset_vrange[intro, simp]:
	assumes "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sup>r\<^sub>\<circ> B = r"
	proof(intro vsubset_antisym)
	show "r \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> B"
	by (rule vrrestriction_mono[OF assms, of r, unfolded vrrestriction_vrange])
	qed auto

	lemma (in vbrelation) vbrelation_vcomp_vid_on_left[simp]:
	assumes "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A"
	shows "vid_on A \<circ>\<^sub>\<circ> r = r"
	using assms by auto

	lemma (in vbrelation) vbrelation_vcomp_vid_on_right[simp]:
	assumes "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A"
	shows "r \<circ>\<^sub>\<circ> vid_on A = r"
	using assms by auto


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro, simp] = vbrelation.vconverse_vconverse
	and [intro, simp] = vbrelation.vlrestriction_vsubset_vrange
	and [intro, simp] = vbrelation.vrrestriction_vsubset_vrange



	subsubsection\<open>Simple single-valued relation\<close>

	locale vsv = vbrelation r for r +
	assumes vsv: "\<lbrakk> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r; \<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<rbrakk> \<Longrightarrow> b = c"


	text\<open>Rules.\<close>

	lemmas (in vsv) [intro] = vsv_axioms

	mk_ide rf vsv_def[unfolded vsv_axioms_def]
	\|intro vsvI[intro]\|
	\|dest vsvD[dest]\|
	\|elim vsvE[elim]\|


	text\<open>Set operations.\<close>

	lemma (in vsv) vsv_vinsert[simp]:
	assumes "a \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "vsv (vinsert \<langle>a, b\<rangle> r)"
	using assms vsv_axioms by blast

	lemma vsv_vinsertD:
	assumes "vsv (vinsert x r)"
	shows "vsv r"
	using assms by (intro vsvI) auto

	lemma vsv_vunion[intro, simp]:
	assumes "vsv r" and "vsv s" and "vdisjnt (\<D>\<^sub>\<circ> r) (\<D>\<^sub>\<circ> s)"
	shows "vsv (r \<union>\<^sub>\<circ> s)"
	proof
	from assms have F: "\<lbrakk> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r; \<langle>a, c\<rangle> \<in>\<^sub>\<circ> s \<rbrakk> \<Longrightarrow> False" for a b c
	using elts_0 by blast
	fix a b c assume "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<union>\<^sub>\<circ> s" and "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<union>\<^sub>\<circ> s"
	then consider
	"\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<and> \<langle>a, c\<rangle> \<in>\<^sub>\<circ> r"
	\| "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<and> \<langle>a, c\<rangle> \<in>\<^sub>\<circ> s"
	\| "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s \<and> \<langle>a, c\<rangle> \<in>\<^sub>\<circ> r"
	\| "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s \<and> \<langle>a, c\<rangle> \<in>\<^sub>\<circ> s"
	by blast
	then show "b = c" using assms by cases auto
	qed (use assms in auto)

	lemma (in vsv) vsv_vintersection[intro, simp]: "vsv (r \<inter>\<^sub>\<circ> s)"
	using vsv_axioms by blast

	lemma (in vsv) vsv_vdiff[intro, simp]: "vsv (r -\<^sub>\<circ> s)" using vsv_axioms by blast


	text\<open>Connections.\<close>

	lemma vsv_vempty[simp]: "vsv 0" by auto

	lemma vsv_vsingleton[simp]: "vsv (set {\<langle>a, b\<rangle>})" by auto

	global_interpretation rel_vsingleton: vsv \<open>set {\<langle>a, b\<rangle>}\<close>
	by (rule vsv_vsingleton)

	lemma vsv_vdoubleton:
	assumes "a \<noteq> c"
	shows "vsv (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>})"
	using assms by (auto simp: vinsert_set_insert_eq)

	lemma vsv_vid_on[simp]: "vsv (vid_on A)" by auto

	lemma vsv_vconst_on[simp]: "vsv (vconst_on A c)" by auto

	lemma vsv_VLambda[simp]: "vsv (\<lambda>a\<in>\<^sub>\<circ>A. f a)" by auto

	global_interpretation rel_VLambda: vsv \<open>(\<lambda>a\<in>\<^sub>\<circ>A. f a)\<close>
	unfolding VLambda_def by (intro vsvI) auto

	lemma vsv_vcomp:
	assumes "vsv r" and "vsv s"
	shows "vsv (r \<circ>\<^sub>\<circ> s)"
	using assms
	by (intro vsvI; elim vsvE) (simp add: vbrelation_vcomp, metis vcompD)

	lemma (in vsv) vsv_vlrestriction[intro, simp]: "vsv (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using vsv_axioms by blast

	lemma (in vsv) vsv_vrrestriction[intro, simp]: "vsv (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	using vsv_axioms by blast

	lemma (in vsv) vsv_vrestriction[intro, simp]: "vsv (r \<restriction>\<^sub>\<circ> A)"
	using vsv_axioms by blast


	text\<open>Special properties.\<close>

	lemma small_vsv[simp]: "small {f. vsv f \<and> \<D>\<^sub>\<circ> f = A \<and> \<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> B}"
	proof-
	have "small {f. f \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B}" by (auto simp: small_iff)
	moreover have "{f. vsv f \<and> \<D>\<^sub>\<circ> f = A \<and> \<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> B} \<subseteq> {f. f \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<circ> B}"
	by auto
	ultimately show "small {f. vsv f \<and> \<D>\<^sub>\<circ> f = A \<and> \<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> B}"
	by (auto simp: smaller_than_small)
	qed

	context vsv
	begin

	lemma vsv_ex1:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "\<exists>!b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using vsv_axioms assms by auto

	lemma vsv_ex1_app1:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "b = r\<lparr>a\<rparr> \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	proof
	assume b_def: "b = r\<lparr>a\<rparr>" show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	unfolding app_def b_def by (rule theI') (rule vsv_ex1[OF assms])
	next
	assume [simp]: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	from assms vsv_axioms vsvD have THE_b: "(THE y. \<langle>a, y\<rangle> \<in>\<^sub>\<circ> r) = b" by auto
	show "b = r\<lparr>a\<rparr>" unfolding app_def THE_b[symmetric] by (rule refl)
	qed

	lemma vsv_ex1_app2[iff]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r\<lparr>a\<rparr> = b \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using vsv_ex1_app1[OF assms] by auto

	lemma vsv_appI[intro, simp]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	shows "r\<lparr>a\<rparr> = b"
	using assms by (subgoal_tac \<open>a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r\<close>) auto

	lemma vsv_appE:
	assumes "r\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r \<Longrightarrow> P"
	shows P
	using assms vsv_ex1_app1 by blast

	lemma vdomain_vrange_is_vempty: "\<D>\<^sub>\<circ> r = 0 \<longleftrightarrow> \<R>\<^sub>\<circ> r = 0" by fastforce

	lemma vsv_vrange_vempty:
	assumes "\<R>\<^sub>\<circ> r = 0"
	shows "r = 0"
	using assms vdomain_vrange_is_vempty vlrestriction_vdomain by auto

	lemma vsv_vdomain_vempty_vrange_vempty:
	assumes "\<D>\<^sub>\<circ> r \<noteq> 0"
	shows "\<R>\<^sub>\<circ> r \<noteq> 0"
	using assms by fastforce

	lemma vsv_vdomain_vsingleton_vrange_vsingleton:
	assumes "\<D>\<^sub>\<circ> r = set {a}"
	obtains b where "\<R>\<^sub>\<circ> r = set {b}"
	proof-
	from assms obtain b where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
	then have "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<Longrightarrow> c = b" for c by (auto simp: vsv)
	moreover with assms have "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r \<Longrightarrow> c = a" for c by force
	ultimately have "\<langle>c, d\<rangle> \<in>\<^sub>\<circ> r \<Longrightarrow> d = b" for c d
	by (metis app_vdomainI assms vsingletonD)
	with ab have "\<R>\<^sub>\<circ> r = set {b}" by blast
	with that show ?thesis by simp
	qed

	lemma vsv_vsubset_vimageE:
	assumes "B \<subseteq>\<^sub>\<circ> r `\<^sub>\<circ> A"
	obtains C where "C \<subseteq>\<^sub>\<circ> A" and "B = r `\<^sub>\<circ> C"
	proof-
	define C where C_def: "C = (r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> B) \<inter>\<^sub>\<circ> A"
	then have "C \<subseteq>\<^sub>\<circ> A" by auto
	moreover have "B = r `\<^sub>\<circ> C"
	unfolding C_def
	proof(intro vsubset_antisym vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> B"
	with assms obtain a where "a \<in>\<^sub>\<circ> A" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using app_vimageE vsubsetD by metis
	then have "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> B \<inter>\<^sub>\<circ> A" by (auto simp: \<open>b \<in>\<^sub>\<circ> B\<close>)
	then show "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> (r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> B \<inter>\<^sub>\<circ> A)" by (auto intro: \<open>\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r\<close>)
	qed (use vsv_axioms in auto)
	ultimately show ?thesis using that by auto
	qed

	lemma vsv_vimage_eqI[intro]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	using assms(2)[unfolded vsv_ex1_app2[OF assms(1)]] assms(3) by auto

	lemma vsv_vimageI1:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	using assms by (simp add: vsv_vimage_eqI)

	lemma vsv_vimageI2:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms by (blast dest: vsv_ex1_app1)

	lemma vsv_vimageI2':
	assumes "b = r\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms by (blast dest: vsv_ex1_app1)

	lemma vsv_value:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	obtains b where "r\<lparr>a\<rparr> = b" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	using assms by (blast dest: vsv_ex1_app1)

	lemma vsv_vimageE:
	assumes "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A"
	obtains x where "r\<lparr>x\<rparr> = b" and "x \<in>\<^sub>\<circ> A"
	using assms vsv_axioms vsv_ex1_app2 by blast

	lemma vsv_vimage_iff: "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A \<longleftrightarrow> (\<exists>a. a \<in>\<^sub>\<circ> A \<and> a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<and> r\<lparr>a\<rparr> = b)"
	using vsv_axioms by (blast intro: vsv_ex1_app1[THEN iffD1])+

	lemma vsv_vimage_vsingleton:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r `\<^sub>\<circ> set {a} = set {r\<lparr>a\<rparr>}"
	using assms by force

	lemma vsv_vimage_vsubsetI:
	assumes "\<And>a. \<lbrakk> a \<in>\<^sub>\<circ> A; a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<rbrakk> \<Longrightarrow> r\<lparr>a\<rparr> \<in>\<^sub>\<circ> B"
	shows "r `\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> B"
	using assms by (metis vsv_vimage_iff vsubsetI)

	lemma vsv_image_vsubset_iff:
	"r `\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> B \<longleftrightarrow> (\<forall>a\<in>\<^sub>\<circ>A. a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<longrightarrow> r\<lparr>a\<rparr> \<in>\<^sub>\<circ> B)"
	by (auto simp: vsv_vimage_iff)

	lemma vsv_vimage_vinsert:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r `\<^sub>\<circ> vinsert a A = vinsert (r\<lparr>a\<rparr>) (r `\<^sub>\<circ> A)"
	using assms vsv_vimage_iff by (intro vsubset_antisym vsubsetI) auto

	lemma vsv_vinsert_vimage[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "vinsert (r\<lparr>a\<rparr>) (r `\<^sub>\<circ> A) = r `\<^sub>\<circ> A"
	using assms by auto

	lemma vsv_is_VLambda[simp]: "(\<lambda>x\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> r. r\<lparr>x\<rparr>) = r"
	using vbrelation
	by (auto simp: app_vdomainI VLambda_iff2 intro!: vsubset_antisym)

	lemma vsv_is_VLambda_on_vlrestriction[intro, simp]:
	assumes "A \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "(\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>x\<rparr>) = r \<restriction>\<^sup>l\<^sub>\<circ> A"
	using assms by (force simp: VLambda_iff2)+

	lemma pairwise_vimageI:
	assumes "\<And>x y.
	\<lbrakk> x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; x \<noteq> y; r\<lparr>x\<rparr> \<noteq> r\<lparr>y\<rparr> \<rbrakk> \<Longrightarrow> P (r\<lparr>x\<rparr>) (r\<lparr>y\<rparr>)"
	shows "vpairwise P (\<R>\<^sub>\<circ> r)"
	by (intro vpairwiseI) (metis assms app_vdomainI app_vrangeE vsv_appI)

	lemma vsv_vrange_vsubset:
	assumes "\<And>x. x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<Longrightarrow> r\<lparr>x\<rparr> \<in>\<^sub>\<circ> A"
	shows "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> A"
	using assms by fastforce

	lemma vsv_vlrestriction_vinsert:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r \<restriction>\<^sup>l\<^sub>\<circ> vinsert a A = vinsert \<langle>a, r\<lparr>a\<rparr>\<rangle> (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using assms by (auto intro!: vsubset_antisym)

	end

	lemma vsv_eqI:
	assumes "vsv r"
	and "vsv s"
	and "\<D>\<^sub>\<circ> r = \<D>\<^sub>\<circ> s"
	and "\<And>a. a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<Longrightarrow> r\<lparr>a\<rparr> = s\<lparr>a\<rparr>"
	shows "r = s"
	proof(intro vsubset_antisym vsubsetI)
	interpret r: vsv r by (rule assms(1))
	interpret s: vsv s by (rule assms(2))
	fix x assume "x \<in>\<^sub>\<circ> r"
	then obtain a b where x_def[simp]: "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	by (elim r.vbrelation_vinE)
	with \<open>x \<in>\<^sub>\<circ> r\<close> have "r\<lparr>a\<rparr> = b" by simp
	with assms \<open>a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r\<close> show "x \<in>\<^sub>\<circ> s" by fastforce
	next
	interpret r: vsv r by (rule assms(1))
	interpret s: vsv s by (rule assms(2))
	fix x assume "x \<in>\<^sub>\<circ> s"
	with assms(2) obtain a b where x_def[simp]: "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	by (elim vsvE) blast
	with assms \<open>x \<in>\<^sub>\<circ> s\<close> have "s\<lparr>a\<rparr> = b" by blast
	with assms \<open>a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s\<close> show "x \<in>\<^sub>\<circ> r" by fastforce
	qed

	lemma (in vsv) vsv_VLambda_cong:
	assumes "\<And>a. a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<Longrightarrow> r\<lparr>a\<rparr> = f a"
	shows "(\<lambda>a\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> r. f a) = r"
	proof(rule vsv_eqI[symmetric])
	show "\<D>\<^sub>\<circ> r = \<D>\<^sub>\<circ> (VLambda (\<D>\<^sub>\<circ> r) f)" by simp
	fix a assume a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	then show "r\<lparr>a\<rparr> = VLambda (\<D>\<^sub>\<circ> r) f \<lparr>a\<rparr>" using assms(1)[OF a] by auto
	qed auto

	lemma Axiom_of_Choice:
	obtains f where "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x" and "vsv f"
	proof-
	obtain f where f: "x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x" for x
	by (metis beta vemptyE)
	define f' where "f' = (\<lambda>x\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>)"
	have "x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f'\<lparr>x\<rparr> \<in>\<^sub>\<circ> x" for x
	unfolding f'_def using f by simp
	moreover have "vsv f'" unfolding f'_def by simp
	ultimately show ?thesis using that by auto
	qed

	lemma VLambda_eqI:
	assumes "X = Y" and "\<And>x. x \<in>\<^sub>\<circ> X \<Longrightarrow> f x = g x"
	shows "(\<lambda>x\<in>\<^sub>\<circ>X. f x) = (\<lambda>y\<in>\<^sub>\<circ>Y. g y)"
	proof(rule vsv_eqI, unfold vdomain_VLambda; (intro assms(1) vsv_VLambda)?)
	fix x assume "x \<in>\<^sub>\<circ> X"
	with assms show "VLambda X f\<lparr>x\<rparr> = VLambda Y g\<lparr>x\<rparr>" by simp
	qed

	lemma VLambda_vsingleton_def: "(\<lambda>i\<in>\<^sub>\<circ>set {j}. f i) = (\<lambda>i\<in>\<^sub>\<circ>set {j}. f j)" by auto


	text\<open>Alternative forms of the available results.\<close>

	lemmas [iff] = vsv.vsv_ex1_app2
	and [intro, simp] = vsv.vsv_appI
	and [elim] = vsv.vsv_appE
	and [intro] = vsv.vsv_vimage_eqI
	and [simp] = vsv.vsv_vinsert_vimage
	and [intro] = vsv.vsv_is_VLambda_on_vlrestriction
	and [simp] = vsv.vsv_is_VLambda
	and [intro, simp] = vsv.vsv_vintersection
	and [intro, simp] = vsv.vsv_vdiff
	and [intro, simp] = vsv.vsv_vlrestriction
	and [intro, simp] = vsv.vsv_vrrestriction
	and [intro, simp] = vsv.vsv_vrestriction


	subsubsection\<open>Specialization of existing properties to single-valued relations.\<close>


	text\<open>Identity relation.\<close>

	lemma vid_on_eq_atI[intro, simp]:
	assumes "a = b" and "a \<in>\<^sub>\<circ> A"
	shows "vid_on A \<lparr>a\<rparr> = b"
	using assms by auto

	lemma vid_on_atI[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "vid_on A \<lparr>a\<rparr> = a"
	using assms by auto

	lemma vid_on_at_iff[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "vid_on A \<lparr>a\<rparr> = b \<longleftrightarrow> a = b"
	using assms by auto


	text\<open>Constant function.\<close>

	lemma vconst_on_atI[simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "vconst_on A c \<lparr>a\<rparr> = c"
	using assms by auto


	text\<open>Composition.\<close>

	lemma vcomp_atI[intro, simp]:
	assumes "vsv r"
	and "vsv s"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	and "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	and "s\<lparr>b\<rparr> = c"
	and "r\<lparr>a\<rparr> = b"
	shows "(s \<circ>\<^sub>\<circ> r)\<lparr>a\<rparr> = c"
	using assms by (auto simp: app_invimageI intro!: vsv_vcomp)

	lemma vcomp_atD[dest]:
	assumes "(s \<circ>\<^sub>\<circ> r)\<lparr>a\<rparr> = c"
	and "vsv r"
	and "vsv s"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	and "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	shows "\<exists>b. s\<lparr>b\<rparr> = c \<and> r\<lparr>a\<rparr> = b"
	using assms by (metis vcomp_atI)

	lemma vcomp_atE1:
	assumes "(s \<circ>\<^sub>\<circ> r)\<lparr>a\<rparr> = c"
	and "vsv r"
	and "vsv s"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	and "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	and "\<exists>b. s\<lparr>b\<rparr> = c \<and> r\<lparr>a\<rparr> = b \<Longrightarrow> P"
	shows P
	using assms assms vcomp_atD by blast

	lemma vcomp_atE[elim]:
	assumes "(s \<circ>\<^sub>\<circ> r)\<lparr>a\<rparr> = c"
	and "vsv r"
	and "vsv s"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	and "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	obtains b where "r\<lparr>a\<rparr> = b" and "s\<lparr>b\<rparr> = c"
	using assms that by (force elim!: vcomp_atE1)

	lemma vsv_vcomp_at[simp]:
	assumes "vsv r" and "vsv s" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	shows "(s \<circ>\<^sub>\<circ> r)\<lparr>a\<rparr> = s\<lparr>r\<lparr>a\<rparr>\<rparr>"
	using assms by auto

	context vsv
	begin


	text\<open>Converse relation.\<close>

	lemma vconverse_atI[intro]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = b"
	shows "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	using assms by auto

	lemma vconverse_atD[dest]:
	assumes "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	shows "r\<lparr>a\<rparr> = b"
	using assms by auto

	lemma vconverse_atE[elim]:
	assumes "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>" and "r\<lparr>a\<rparr> = b \<Longrightarrow> P"
	shows P
	using assms by auto

	lemma vconverse_iff:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> \<longleftrightarrow> r\<lparr>a\<rparr> = b"
	using assms by auto


	text\<open>Left restriction.\<close>

	interpretation vlrestriction: vsv \<open>r \<restriction>\<^sup>l\<^sub>\<circ> A\<close> by (rule vsv_vlrestriction)

	lemma vlrestriction_atI[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	shows "(r \<restriction>\<^sup>l\<^sub>\<circ> A)\<lparr>a\<rparr> = b"
	using assms by (auto simp: vdomain_vlrestriction)

	lemma vlrestriction_atD[dest]:
	assumes "(r \<restriction>\<^sup>l\<^sub>\<circ> A)\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "r\<lparr>a\<rparr> = b"
	using assms by (auto simp: vdomain_vlrestriction)

	lemma vlrestriction_atE1[elim]:
	assumes "(r \<restriction>\<^sup>l\<^sub>\<circ> A)\<lparr>a\<rparr> = b"
	and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	and "a \<in>\<^sub>\<circ> A"
	and "r\<lparr>a\<rparr> = b \<Longrightarrow> P"
	shows P
	using assms vlrestrictionD by blast

	lemma vlrestriction_atE2[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	using assms by auto


	text\<open>Right restriction.\<close>

	interpretation vrrestriction: vsv \<open>r \<restriction>\<^sup>r\<^sub>\<circ> A\<close> by (rule vsv_vrrestriction)

	lemma vrrestriction_atI[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	shows "(r \<restriction>\<^sup>r\<^sub>\<circ> A)\<lparr>a\<rparr> = b"
	using assms by (auto simp: app_vrrestrictionI)

	lemma vrrestriction_atD[dest]:
	assumes "(r \<restriction>\<^sup>r\<^sub>\<circ> A)\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	using assms by force+

	lemma vrrestriction_atE1[elim]:
	assumes "(r \<restriction>\<^sup>r\<^sub>\<circ> A)\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b \<Longrightarrow> P"
	shows P
	using assms by (auto simp: vrrestriction_atD(2))

	lemma vrrestriction_atE2[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "b \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	using assms unfolding vrrestriction_def by auto


	text\<open>Restriction.\<close>

	interpretation vrestriction: vsv \<open>r \<restriction>\<^sub>\<circ> A\<close> by (rule vsv_vrestriction)

	lemma vlrestriction_app[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "(r \<restriction>\<^sup>l\<^sub>\<circ> A)\<lparr>a\<rparr> = r\<lparr>a\<rparr>"
	using assms by auto

	lemma vrestriction_atD[dest]:
	assumes "(r \<restriction>\<^sub>\<circ> A)\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A" and "a \<in>\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	proof-
	from assms have "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
	then show "r\<lparr>a\<rparr> = b"
	by
	(
	metis
	assms
	app_invimageD1
	vrrestriction.vlrestriction_atD
	vrrestriction_atD(2)
	vrrestriction_vlrestriction
	)
	then show "b \<in>\<^sub>\<circ> A" using assms(2) by blast
	qed

	lemma vrestriction_atE1[elim]:
	assumes "(r \<restriction>\<^sub>\<circ> A)\<lparr>a\<rparr> = b"
	and "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A"
	and "a \<in>\<^sub>\<circ> A"
	and "r\<lparr>a\<rparr> = b \<Longrightarrow> P"
	shows P
	using assms vrestriction_atD(2) by blast

	lemma vrestriction_atE2[elim]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<circ> A"
	obtains a b where "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "r\<lparr>a\<rparr> = b"
	using assms unfolding vrestriction_def by clarsimp


	text\<open>Domain.\<close>

	lemma vdomain_atD:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "\<exists>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b"
	using assms by (blast intro: vsv_vimageI2)

	lemma vdomain_atE:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	obtains b where "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = b"
	using assms by auto


	text\<open>Range.\<close>

	lemma vrange_atD:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "\<exists>a\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b"
	using assms by auto

	lemma vrange_atE:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	obtains a where "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = b"
	using assms by auto


	text\<open>Image.\<close>

	lemma vimage_set_eq_at:
	"{b. \<exists>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b} = {b. \<exists>a\<in>\<^sub>\<circ>A. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule subset_antisym; rule subsetI; unfold mem_Collect_eq) auto

	lemma vimage_small[simp]: "small {b. \<exists>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b}"
	unfolding vimage_set_eq_at by auto

	lemma vimage_set_def: "r `\<^sub>\<circ> A = set {b. \<exists>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b}"
	unfolding vimage_set_eq_at by (simp add: app_vimage_set_def)

	lemma vimage_set_iff: "b \<in>\<^sub>\<circ> r `\<^sub>\<circ> A \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b)"
	unfolding vimage_set_eq_at using vsv_vimage_iff by auto


	text\<open>Further derived results.\<close>

	lemma vimage_image:
	assumes "A \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "elts (r `\<^sub>\<circ> A) = (\<lambda>x. r\<lparr>x\<rparr>) ` (elts A)"
	using vimage_def assms small_elts by blast

	lemma vsv_vinsert_match_appI[intro, simp]:
	assumes "a \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "vinsert \<langle>a, b\<rangle> r \<lparr>a\<rparr> = b"
	using assms vsv_axioms by simp

	lemma vsv_vinsert_no_match_appI:
	assumes "a \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "c \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r \<lparr>c\<rparr> = d"
	shows "vinsert \<langle>a, b\<rangle> r \<lparr>c\<rparr> = d"
	using assms vsv_axioms by simp

	lemma vsv_is_vconst_onI:
	assumes "\<D>\<^sub>\<circ> r = A" and "\<R>\<^sub>\<circ> r = set {a}"
	shows "r = vconst_on A a"
	unfolding assms(1)[symmetric]
	proof(cases \<open>\<D>\<^sub>\<circ> r = 0\<close>)
	case True
	with assms show "r = vconst_on (\<D>\<^sub>\<circ> r) a"
	by (auto simp: vdomain_vrange_is_vempty)
	next
	case False
	show "r = vconst_on (\<D>\<^sub>\<circ> r) a"
	proof(rule vsv_eqI)
	fix a' assume prems: "a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	then obtain b where "r\<lparr>a'\<rparr> = b" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	moreover then have "b = a" unfolding assms by simp
	ultimately show "r\<lparr>a'\<rparr> = vconst_on (\<D>\<^sub>\<circ> r) a\<lparr>a'\<rparr>" by (simp add: prems)
	qed auto
	qed

	lemma vsv_vdomain_vrange_vsingleton:
	assumes "\<D>\<^sub>\<circ> r = set {a}" and "\<R>\<^sub>\<circ> r = set{b}"
	shows "r = set {\<langle>a, b\<rangle>}"
	using assms vsv_is_vconst_onI by auto

	end


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro] = vsv.vconverse_atI
	and vsv_vconverse_atD[dest] = vsv.vconverse_atD[rotated]
	and vsv_vconverse_atE[elim] = vsv.vconverse_atE[rotated]
	and [intro, simp] = vsv.vlrestriction_atI
	and vsv_vlrestriction_atD[dest] = vsv.vlrestriction_atD[rotated]
	and vsv_vlrestriction_atE1[elim] = vsv.vlrestriction_atE1[rotated]
	and vsv_vlrestriction_atE2[elim] = vsv.vlrestriction_atE2[rotated]
	and [intro, simp] = vsv.vrrestriction_atI
	and vsv_vrrestriction_atD[dest] = vsv.vrrestriction_atD[rotated]
	and vsv_vrrestriction_atE1[elim] = vsv.vrrestriction_atE1[rotated]
	and vsv_vrrestriction_atE2[elim] = vsv.vrrestriction_atE2[rotated]
	and [intro, simp] = vsv.vlrestriction_app
	and vsv_vrestriction_atD[dest] = vsv.vrestriction_atD[rotated]
	and vsv_vrestriction_atE1[elim] = vsv.vrestriction_atE1[rotated]
	and vsv_vrestriction_atE2[elim] = vsv.vrestriction_atE2[rotated]
	and vsv_vdomain_atD = vsv.vdomain_atD[rotated]
	and vsv_vdomain_atE = vsv.vdomain_atE[rotated]
	and vrange_atD = vsv.vrange_atD[rotated]
	and vrange_atE = vsv.vrange_atE[rotated]
	and vsv_vinsert_match_appI[intro, simp] = vsv.vsv_vinsert_match_appI
	and vsv_vinsert_no_match_appI[intro, simp] =
	vsv.vsv_vinsert_no_match_appI[rotated 3]


	text\<open>Corollaries of the alternative forms of existing results.\<close>

	lemma vsv_vlrestriction_vrange:
	assumes "vsv s" and "vsv (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)"
	shows "vsv (r \<circ>\<^sub>\<circ> s)"
	proof(rule vsvI)
	show "vbrelation (r \<circ>\<^sub>\<circ> s)" by auto
	fix a c c' assume "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s" "\<langle>a, c'\<rangle> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<circ> s"
	then obtain b and b'
	where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> s"
	and bc: "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r"
	and ab': "\<langle>a, b'\<rangle> \<in>\<^sub>\<circ> s"
	and b'c': "\<langle>b', c'\<rangle> \<in>\<^sub>\<circ> r"
	by clarsimp
	moreover then have "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> s" and "b' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> s" by auto
	ultimately have "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)" and "\<langle>b', c'\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)" by auto
	with ab ab' have "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s) \<circ>\<^sub>\<circ> s" and "\<langle>a, c'\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s) \<circ>\<^sub>\<circ> s"
	by blast+
	moreover from assms have "vsv ((r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s) \<circ>\<^sub>\<circ> s)" by (intro vsv_vcomp)
	ultimately show "c = c'" by auto
	qed

	lemma vsv_vunion_app_right[simp]:
	assumes "vsv r" and "vsv s" and "vdisjnt (\<D>\<^sub>\<circ> r) (\<D>\<^sub>\<circ> s)" and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> s"
	shows "(r \<union>\<^sub>\<circ> s)\<lparr>x\<rparr> = s\<lparr>x\<rparr>"
	using assms vsubsetD by blast

	lemma vsv_vunion_app_left[simp]:
	assumes "vsv r" and "vsv s" and "vdisjnt (\<D>\<^sub>\<circ> r) (\<D>\<^sub>\<circ> s)" and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "(r \<union>\<^sub>\<circ> s)\<lparr>x\<rparr> = r\<lparr>x\<rparr>"
	using assms vsubsetD by blast


	subsubsection\<open>One-to-one relation\<close>

	locale v11 = vsv r for r +
	assumes vsv_vconverse: "vsv (r\<inverse>\<^sub>\<circ>)"


	text\<open>Rules.\<close>

	lemmas (in v11) [intro] = v11_axioms

	mk_ide rf v11_def[unfolded v11_axioms_def]
	\|intro v11I[intro]\|
	\|dest v11D[dest]\|
	\|elim v11E[elim]\|


	text\<open>Set operations.\<close>

	lemma (in v11) v11_vinsert[intro, simp]:
	assumes "a \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "v11 (vinsert \<langle>a, b\<rangle> r)"
	using assms v11_axioms
	by (intro v11I; elim v11E) (simp_all add: vconverse_vinsert vsv.vsv_vinsert)

	lemma v11_vinsertD:
	assumes "v11 (vinsert x r)"
	shows "v11 r"
	using assms by (intro v11I) (auto simp: vsv_vinsertD)

	lemma v11_vunion:
	assumes "v11 r"
	and "v11 s"
	and "vdisjnt (\<D>\<^sub>\<circ> r) (\<D>\<^sub>\<circ> s)"
	and "vdisjnt (\<R>\<^sub>\<circ> r) (\<R>\<^sub>\<circ> s)"
	shows "v11 (r \<union>\<^sub>\<circ> s)"
	proof
	interpret r: v11 r by (rule assms(1))
	interpret s: v11 s by (rule assms(2))
	show "vsv (r \<union>\<^sub>\<circ> s)" by (simp add: assms v11D)
	from assms show "vsv ((r \<union>\<^sub>\<circ> s)\<inverse>\<^sub>\<circ>)"
	by (simp add: assms r.vsv_vconverse s.vsv_vconverse vconverse_vunion)
	qed

	lemma (in v11) v11_vintersection[intro, simp]: "v11 (r \<inter>\<^sub>\<circ> s)"
	using v11_axioms by (intro v11I) auto

	lemma (in v11) v11_vdiff[intro, simp]: "v11 (r -\<^sub>\<circ> s)"
	using v11_axioms by (intro v11I) auto


	text\<open>Special properties.\<close>

	lemma (in vsv) vsv_valneq_v11I:
	assumes "\<And>x y. \<lbrakk> x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; x \<noteq> y \<rbrakk> \<Longrightarrow> r\<lparr>x\<rparr> \<noteq> r\<lparr>y\<rparr>"
	shows "v11 r"
	proof(intro v11I)
	from vsv_axioms show "vsv r" by simp
	show "vsv (r\<inverse>\<^sub>\<circ>)"
	by
	(
	metis
	assms
	vbrelation_vconverse
	vconverse_atD
	app_vrangeI
	vrange_vconverse
	vsvI
	)
	qed

	lemma (in vsv) vsv_valeq_v11I:
	assumes "\<And>x y. \<lbrakk> x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r; r\<lparr>x\<rparr> = r\<lparr>y\<rparr> \<rbrakk> \<Longrightarrow> x = y"
	shows "v11 r"
	using assms vsv_valneq_v11I by auto


	text\<open>Connections.\<close>

	lemma v11_vempty[simp]: "v11 0" by (simp add: v11I)

	lemma v11_vsingleton[simp]: "v11 (set {\<langle>a, b\<rangle>})" by auto

	lemma v11_vdoubleton:
	assumes "a \<noteq> c" and "b \<noteq> d"
	shows "v11 (set {\<langle>a, b\<rangle>, \<langle>c, d\<rangle>})"
	using assms by (auto simp: vinsert_set_insert_eq)

	lemma v11_vid_on[simp]: "v11 (vid_on A)" by auto

	lemma v11_VLambda[intro]:
	assumes "inj_on f (elts A)"
	shows "v11 (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	proof(rule rel_VLambda.vsv_valneq_v11I)
	fix x y
	assume "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)" and "y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>A. f a)" and "x \<noteq> y"
	then have "x \<in>\<^sub>\<circ> A" and "y \<in>\<^sub>\<circ> A" by auto
	with assms \<open>x \<noteq> y\<close> have "f x \<noteq> f y" by (auto dest: inj_onD)
	then show "(\<lambda>a\<in>\<^sub>\<circ>A. f a)\<lparr>x\<rparr> \<noteq> (\<lambda>a\<in>\<^sub>\<circ>A. f a)\<lparr>y\<rparr>"
	by (simp add: \<open>x \<in>\<^sub>\<circ> A\<close> \<open>y \<in>\<^sub>\<circ> A\<close>)
	qed

	lemma v11_vcomp:
	assumes "v11 r" and "v11 s"
	shows "v11 (r \<circ>\<^sub>\<circ> s)"
	using assms by (intro v11I; elim v11E) (auto simp: vsv_vcomp vconverse_vcomp)

	context v11
	begin

	lemma v11_vconverse: "v11 (r\<inverse>\<^sub>\<circ>)" by (auto simp: vsv_axioms vsv_vconverse)

	interpretation v11 \<open>r\<inverse>\<^sub>\<circ>\<close> by (rule v11_vconverse)

	lemma v11_vlrestriction[intro, simp]: "v11 (r \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using vsv_vrrestriction by (auto simp: vrrestriction_vconverse)

	lemma v11_vrrestriction[intro, simp]: "v11 (r \<restriction>\<^sup>r\<^sub>\<circ> A)"
	using vsv_vlrestriction by (auto simp: vlrestriction_vconverse)

	lemma v11_vrestriction[intro, simp]: "v11 (r \<restriction>\<^sub>\<circ> A)"
	using vsv_vrestriction by (auto simp: vrestriction_vconverse)

	end


	text\<open>Further Special properties.\<close>

	context v11
	begin

	lemma v11_injective:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = r\<lparr>b\<rparr>"
	shows "a = b"
	using assms v11_axioms by auto

	lemma v11_double_pair:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "a' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "r\<lparr>a\<rparr> = b" and "r\<lparr>a'\<rparr> = b'"
	shows "a = a' \<longleftrightarrow> b = b'"
	using assms v11_axioms by auto

	lemma v11_vrange_ex1_eq: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<longleftrightarrow> (\<exists>!a\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> r. r\<lparr>a\<rparr> = b)"
	proof(rule iffI)
	from app_vdomainI v11_injective show
	"b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r \<Longrightarrow> \<exists>!a. a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<and> r\<lparr>a\<rparr> = b"
	by (elim app_vrangeE) auto
	show "\<exists>!a. a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r \<and> r\<lparr>a\<rparr> = b \<Longrightarrow> b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	by (auto intro: vsv_vimageI2)
	qed

	lemma v11_VLambda_iff: "inj_on f (elts A) \<longleftrightarrow> v11 (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	by (rule iffI; (intro inj_onI \| tactic\<open>all_tac\<close>))
	(auto simp: v11.v11_injective)

	lemma v11_vimage_vpsubset_neq:
	assumes "A \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "B \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "A \<noteq> B"
	shows "r `\<^sub>\<circ> A \<noteq> r `\<^sub>\<circ> B"
	proof-
	from assms obtain a where AB: "a \<in>\<^sub>\<circ> A \<or> a \<in>\<^sub>\<circ> B" and nAB: "a \<notin>\<^sub>\<circ> A \<or> a \<notin>\<^sub>\<circ> B"
	by auto
	then have "r\<lparr>a\<rparr> \<notin>\<^sub>\<circ> r `\<^sub>\<circ> A \<or> r\<lparr>a\<rparr> \<notin>\<^sub>\<circ> r `\<^sub>\<circ> B"
	unfolding vsv_vimage_iff by (metis assms(1,2) v11_injective vsubsetD)
	moreover from AB nAB assms(1,2) have "r\<lparr>a\<rparr> \<in>\<^sub>\<circ> r `\<^sub>\<circ> A \<or> r\<lparr>a\<rparr> \<in>\<^sub>\<circ> r `\<^sub>\<circ> B"
	by auto
	ultimately show "r `\<^sub>\<circ> A \<noteq> r `\<^sub>\<circ> B" by clarsimp
	qed

	lemma v11_eq_iff[simp]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r\<lparr>a\<rparr> = r\<lparr>b\<rparr> \<longleftrightarrow> a = b"
	using assms v11_double_pair by blast

	lemma v11_vcomp_vconverse: "r\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r = vid_on (\<D>\<^sub>\<circ> r)"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r"
	then obtain a c where x_def: "x = \<langle>a, c\<rangle>" and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
	with prems obtain b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" and "\<langle>b, c\<rangle> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>" by auto
	with v11.vsv_vconverse v11_axioms have ca: "c = a" by auto
	from a show "x \<in>\<^sub>\<circ> vid_on (\<D>\<^sub>\<circ> r)" unfolding x_def ca by auto
	next
	fix x assume "x \<in>\<^sub>\<circ> vid_on (\<D>\<^sub>\<circ> r)"
	then obtain a where x_def: "x = \<langle>a, a\<rangle>" and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by clarsimp
	then obtain b where "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
	then show "x \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r" unfolding x_def using a by auto
	qed

	lemma v11_vcomp_vconverse': "r \<circ>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> = vid_on (\<R>\<^sub>\<circ> r)"
	using v11.v11_vcomp_vconverse v11_vconverse by force

	lemma v11_vconverse_app[simp]:
	assumes "r\<lparr>a\<rparr> = b" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r\<inverse>\<^sub>\<circ>\<lparr>b\<rparr> = a"
	using assms by (simp add: vsv.vconverse_iff vsv_axioms vsv_vconverse)

	lemma v11_vconverse_app_in_vdomain:
	assumes "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "r\<inverse>\<^sub>\<circ>\<lparr>y\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	using assms v11_vconverse
	unfolding vrange_vconverse[symmetric]
	by (auto simp: v11_def)

	lemma v11_app_if_vconverse_app:
	assumes "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" and "r\<inverse>\<^sub>\<circ>\<lparr>y\<rparr> = x"
	shows "r\<lparr>x\<rparr> = y"
	using assms vsv_vconverse by auto

	lemma v11_app_vconverse_app:
	assumes "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	shows "r\<lparr>r\<inverse>\<^sub>\<circ>\<lparr>a\<rparr>\<rparr> = a"
	using assms by (meson v11_app_if_vconverse_app)

	lemma v11_vconverse_app_app:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r"
	shows "r\<inverse>\<^sub>\<circ>\<lparr>r\<lparr>a\<rparr>\<rparr> = a"
	using assms v11_vconverse_app by auto

	end

	lemma v11_vlrestriction_vsubset:
	assumes "v11 (f \<restriction>\<^sup>l\<^sub>\<circ> A)" and "B \<subseteq>\<^sub>\<circ> A"
	shows "v11 (f \<restriction>\<^sup>l\<^sub>\<circ> B)"
	proof-
	from assms have fB_def: "f \<restriction>\<^sup>l\<^sub>\<circ> B = (f \<restriction>\<^sup>l\<^sub>\<circ> A) \<restriction>\<^sup>l\<^sub>\<circ> B" by auto
	show ?thesis unfolding fB_def by (intro v11.v11_vlrestriction assms(1))
	qed

	lemma v11_vlrestriction_vrange:
	assumes "v11 s" and "v11 (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)"
	shows "v11 (r \<circ>\<^sub>\<circ> s)"
	proof(intro v11I)
	interpret v11 s by (rule assms(1))
	from assms vsv_vlrestriction_vrange show "vsv (r \<circ>\<^sub>\<circ> s)"
	by (simp add: v11.axioms(1))
	show "vsv ((r \<circ>\<^sub>\<circ> s)\<inverse>\<^sub>\<circ>)"
	unfolding vconverse_vcomp
	proof(rule vsvI)
	fix a c c' assume "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> s\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>" "\<langle>a, c'\<rangle> \<in>\<^sub>\<circ> s\<inverse>\<^sub>\<circ> \<circ>\<^sub>\<circ> r\<inverse>\<^sub>\<circ>"
	then obtain b and b'
	where "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> r"
	and bc: "\<langle>c, b\<rangle> \<in>\<^sub>\<circ> s"
	and "\<langle>b', a\<rangle> \<in>\<^sub>\<circ> r"
	and b'c': "\<langle>c', b'\<rangle> \<in>\<^sub>\<circ> s"
	by auto
	moreover then have "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> s" and "b' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> s" by auto
	ultimately have "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)" and "\<langle>b', a\<rangle> \<in>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> \<R>\<^sub>\<circ> s)" by auto
	with assms(2) have bb': "b = b'" by auto
	from assms bc[unfolded bb'] b'c' show "c = c'" by auto
	qed auto
	qed

	lemma v11_vlrestriction_vcomp:
	assumes "v11 (f \<restriction>\<^sup>l\<^sub>\<circ> A)" and "v11 (g \<restriction>\<^sup>l\<^sub>\<circ> (f `\<^sub>\<circ> A))"
	shows "v11 ((g \<circ>\<^sub>\<circ> f) \<restriction>\<^sup>l\<^sub>\<circ> A)"
	using assms v11_vlrestriction_vrange by (auto simp: assms(2) app_vimage_def)


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro, simp] = v11.v11_vinsert
	and [intro, simp] = v11.v11_vintersection
	and [intro, simp] = v11.v11_vdiff
	and [intro, simp] = v11.v11_vrrestriction
	and [intro, simp] = v11.v11_vlrestriction
	and [intro, simp] = v11.v11_vrestriction
	and [intro] = v11.v11_vimage_vpsubset_neq



	subsection\<open>Tools: \<open>mk_VLambda\<close>\<close>

	ML\<open>

	(* low level unfold *)
	(Designed based on an algorithm from HOL-Types_To_Sets/unoverload_def.ML)
	fun pure_unfold ctxt thms = ctxt
	\|>
	(
	thms
	\|> Conv.rewrs_conv
	\|> Conv.try_conv
	\|> K
	\|> Conv.top_conv
	)
	\|> Conv.fconv_rule;

	val msg_args = "mk_VLambda: invalid arguments"

	val vsv_VLambda_thm = @{thm vsv_VLambda};
	val vsv_VLambda_match = vsv_VLambda_thm
	\|> Thm.full_prop_of
	\|> HOLogic.dest_Trueprop
	\|> dest_comb
	\|> #2;

	val vdomain_VLambda_thm = @{thm vdomain_VLambda};
	val vdomain_VLambda_match = vdomain_VLambda_thm
	\|> Thm.full_prop_of
	\|> HOLogic.dest_Trueprop
	\|> HOLogic.dest_eq
	\|> #1
	\|> dest_comb
	\|> #2;

	val app_VLambda_thm = @{thm ZFC_Cardinals.beta};
	val app_VLambda_match = app_VLambda_thm
	\|> Thm.concl_of
	\|> HOLogic.dest_Trueprop
	\|> HOLogic.dest_eq
	\|> #1
	\|> strip_comb
	\|> #2
	\|> hd;

	fun mk_VLabmda_thm match_t match_thm ctxt thm =
	let
	val thm_ct = Thm.cprop_of thm
	val (_, rhs_ct) = Thm.dest_equals thm_ct
	handle TERM ("dest_equals", _) => error msg_args
	val insts = Thm.match (Thm.cterm_of ctxt match_t, rhs_ct)
	handle Pattern.MATCH => error msg_args
	in
	match_thm
	\|> Drule.instantiate_normalize insts
	\|> pure_unfold ctxt (thm \|> Thm.symmetric \|> single)
	end;

	val mk_VLambda_vsv =
	mk_VLabmda_thm vsv_VLambda_match vsv_VLambda_thm;
	val mk_VLambda_vdomain =
	mk_VLabmda_thm vdomain_VLambda_match vdomain_VLambda_thm;
	val mk_VLambda_app =
	mk_VLabmda_thm app_VLambda_match app_VLambda_thm;

	val mk_VLambda_parser = Parse.thm --
	(
	Scan.repeat
	(
	(\<^keyword>\<open>\|vsv\<close> -- Parse_Spec.opt_thm_name "\|") \|\|
	(\<^keyword>\<open>\|app\<close> -- Parse_Spec.opt_thm_name "\|") \|\|
	(\<^keyword>\<open>\|vdomain\<close> -- Parse_Spec.opt_thm_name "\|")
	)
	);

	fun process_mk_VLambda_thm mk_VLambda_thm (b, thm) ctxt =
	let
	val thm' = mk_VLambda_thm ctxt thm
	val ((c, thms'), ctxt') = ctxt
	\|> Local_Theory.note (b \|\|> map (Attrib.check_src ctxt), single thm')
	val _ = IDE_Utilities.thm_printer ctxt' true c thms'
	in ctxt' end;

	fun folder_mk_VLambda (("\|vsv", b), thm) ctxt =
	process_mk_VLambda_thm mk_VLambda_vsv (b, thm) ctxt
	\| folder_mk_VLambda (("\|app", b), thm) ctxt =
	process_mk_VLambda_thm mk_VLambda_app (b, thm) ctxt
	\| folder_mk_VLambda (("\|vdomain", b), thm) ctxt =
	process_mk_VLambda_thm mk_VLambda_vdomain (b, thm) ctxt
	\| folder_mk_VLambda _ _ = error msg_args

	fun process_mk_VLambda (thm, ins) ctxt =
	let
	val _ = ins \|> map fst \|> has_duplicates op= \|> not orelse error msg_args
	val thm' = thm
	\|> singleton (Attrib.eval_thms ctxt)
	\|> Local_Defs.meta_rewrite_rule ctxt;
	in fold folder_mk_VLambda (map (fn x => (x, thm')) ins) ctxt end;

	val _ =
	Outer_Syntax.local_theory
	\<^command_keyword>\<open>mk_VLambda\<close>
	"VLambda"
	(mk_VLambda_parser >> process_mk_VLambda);

	\<close>

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_FBRelations.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_FBRelations.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_FBRelations.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_FBRelations.thy
	@@ -1,1544 +1,1544 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Binary relation as a finite sequence\<close>
	theory CZH_Sets_FBRelations
	imports CZH_Sets_FSequences
	begin



	subsection\<open>Background\<close>


	text\<open>
	This section exposes the theory of binary relations that are represented by
	a two element finite sequence \<open>[a, b]\<^sub>\<circ>\<close> (as opposed to a pair \<open>\<langle>a, b\<rangle>\<close>).
	Many results were adapted from the theory \<open>CZH_Sets_BRelations\<close>.

	As previously, many of the results that are presented in this
	section can be assumed to have been adapted (with amendments) from the
	theory \<^text>\<open>Relation\<close> in the main library.
	\<close>

	lemma fpair_iff[simp]: "([a, b]\<^sub>\<circ> = [a', b']\<^sub>\<circ>) = (a = a' \<and> b = b')" by simp

	lemmas fpair_inject[elim!] = fpair_iff[THEN iffD1, THEN conjE]



	subsection\<open>\<open>fpairs\<close>\<close>

	definition fpairs :: "V \<Rightarrow> V" where
	"fpairs r = set {x. x \<in>\<^sub>\<circ> r \<and> (\<exists>a b. x = [a, b]\<^sub>\<circ>)}"

	lemma small_fpairs[simp]: "small {x. x \<in>\<^sub>\<circ> r \<and> (\<exists>a b. x = [a, b]\<^sub>\<circ>)}"
	by (rule down[of _ r]) clarsimp


	text\<open>Rules.\<close>

	lemma fpairsI[intro]:
	assumes "x \<in>\<^sub>\<circ> r" and "x = [a, b]\<^sub>\<circ>"
	shows "x \<in>\<^sub>\<circ> fpairs r"
	using assms unfolding fpairs_def by auto

	lemma fpairsD[dest]:
	assumes "x \<in>\<^sub>\<circ> fpairs r"
	shows "x \<in>\<^sub>\<circ> r" and "\<exists>a b. x = [a, b]\<^sub>\<circ>"
	using assms unfolding fpairs_def by auto

	lemma fpairsE[elim]:
	assumes "x \<in>\<^sub>\<circ> fpairs r"
	obtains a b where "x = [a, b]\<^sub>\<circ>" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fpairs_def by auto

	lemma fpairs_iff: "x \<in>\<^sub>\<circ> fpairs r \<longleftrightarrow> x \<in>\<^sub>\<circ> r \<and> (\<exists>a b. x = [a, b]\<^sub>\<circ>)" by auto


	text\<open>Elementary properties.\<close>

	lemma fpairs_iff_elts: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> fpairs r \<longleftrightarrow> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto


	text\<open>Set operations.\<close>

	lemma fpairs_vempty[simp]: "fpairs 0 = 0" by auto

	lemma fpairs_vsingleton[simp]: "fpairs (set {[a, b]\<^sub>\<circ>}) = set {[a, b]\<^sub>\<circ>}" by auto

	lemma fpairs_vinsert: "fpairs (vinsert [a, b]\<^sub>\<circ> A) = set {[a, b]\<^sub>\<circ>} \<union>\<^sub>\<circ> fpairs A"
	by auto

	lemma fpairs_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "fpairs r \<subseteq>\<^sub>\<circ> fpairs s"
	using assms by blast

	lemma fpairs_vunion: "fpairs (A \<union>\<^sub>\<circ> B) = fpairs A \<union>\<^sub>\<circ> fpairs B" by auto

	lemma fpairs_vintersection: "fpairs (A \<inter>\<^sub>\<circ> B) = fpairs A \<inter>\<^sub>\<circ> fpairs B" by auto

	lemma fpairs_vdiff: "fpairs (A -\<^sub>\<circ> B) = fpairs A -\<^sub>\<circ> fpairs B" by auto


	text\<open>Special properties.\<close>

	lemma fpairs_ex_vfst:
	assumes "x \<in>\<^sub>\<circ> fpairs r"
	shows "\<exists>b. [x\<lparr>0\<^sub>\<nat>\<rparr>, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	proof-
	from assms have xr: "x \<in>\<^sub>\<circ> r" by auto
	moreover from assms obtain b where x_def: "x = [x\<lparr>0\<^sub>\<nat>\<rparr>, b]\<^sub>\<circ>" by auto
	ultimately have "[x\<lparr>0\<^sub>\<nat>\<rparr>, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto
	then show ?thesis by auto
	qed

	lemma fpairs_ex_vsnd:
	assumes "x \<in>\<^sub>\<circ> fpairs r"
	shows "\<exists>a. [a, x\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	proof-
	from assms have xr: "x \<in>\<^sub>\<circ> r" by auto
	moreover from assms obtain a where x_def: "x = [a, x\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>"
	by (auto simp: nat_omega_simps)
	ultimately have "[a, x\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto
	then show ?thesis by auto
	qed

	lemma fpair_vcpower2I[intro]:
	assumes "a \<in>\<^sub>\<circ> A ^\<^sub>\<times> 1\<^sub>\<nat>" and "b \<in>\<^sub>\<circ> A ^\<^sub>\<times> 1\<^sub>\<nat>"
	shows "vconcat [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
	proof-
	from assms obtain a' b'
	where a_def: "a = [a']\<^sub>\<circ>" and b_def: "b = [b']\<^sub>\<circ>" and "a'\<in>\<^sub>\<circ> A" and "b'\<in>\<^sub>\<circ> A"
	by (force elim: vcons_vcpower1E)
	then show ?thesis by (auto simp: nat_omega_simps)
	qed



	subsection\<open>Constructors\<close>


	subsubsection\<open>Identity relation\<close>

	definition fid_on :: "V \<Rightarrow> V"
	where "fid_on A = set {[a, a]\<^sub>\<circ> \| a. a \<in>\<^sub>\<circ> A}"

	lemma fid_on_small[simp]: "small {[a, a]\<^sub>\<circ> \| a. a \<in>\<^sub>\<circ> A}"
	proof(rule down[of _ \<open>A ^\<^sub>\<times> (2\<^sub>\<nat>)\<close>], intro subsetI)
	fix x assume "x \<in> {[a, a]\<^sub>\<circ> \|a. a \<in>\<^sub>\<circ> A}"
	then obtain a where x_def: "x = [a, a]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" by clarsimp
	interpret vfsequence \<open>[a, a]\<^sub>\<circ>\<close> by simp
	have vcard_aa: "2\<^sub>\<nat> = vcard [a, a]\<^sub>\<circ>" by (simp add: nat_omega_simps)
	from \<open>a \<in>\<^sub>\<circ> A\<close> show "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
	unfolding x_def vcard_aa by (intro vfsequence_vrange_vcpower) auto
	qed


	text\<open>Rules.\<close>

	lemma fid_on_eqI:
	assumes "a = b" and "a \<in>\<^sub>\<circ> A"
	shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> fid_on A"
	using assms by (simp add: fid_on_def)

	lemma fid_onI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "[a, a]\<^sub>\<circ> \<in>\<^sub>\<circ> fid_on A"
	by (rule fid_on_eqI) (simp_all add: assms)

	lemma fid_onD[dest!]:
	assumes "[a, a]\<^sub>\<circ> \<in>\<^sub>\<circ> fid_on A"
	shows "a \<in>\<^sub>\<circ> A"
	using assms unfolding fid_on_def by auto

	lemma fid_onE[elim!]:
	assumes "x \<in>\<^sub>\<circ> fid_on A" and "\<exists>a\<in>\<^sub>\<circ>A. x = [a, a]\<^sub>\<circ> \<Longrightarrow> P"
	shows P
	using assms unfolding fid_on_def by auto

	lemma fid_on_iff: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> fid_on A \<longleftrightarrow> a = b \<and> a \<in>\<^sub>\<circ> A" by auto


	text\<open>Set operations.\<close>

	lemma fid_on_vempty[simp]: "fid_on 0 = 0" by auto

	lemma fid_on_vsingleton[simp]: "fid_on (set {a}) = set {[a, a]\<^sub>\<circ>}" by auto

	lemma fid_on_vdoubleton: "fid_on (set {a, b}) = set {[a, a]\<^sub>\<circ>, [b, b]\<^sub>\<circ>}" by force

	lemma fid_on_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "fid_on A \<subseteq>\<^sub>\<circ> fid_on B"
	using assms by auto

	lemma fid_on_vinsert: "vinsert [a, a]\<^sub>\<circ> (fid_on A) = fid_on (vinsert a A)"
	by auto

	lemma fid_on_vintersection: "fid_on (A \<inter>\<^sub>\<circ> B) = fid_on A \<inter>\<^sub>\<circ> fid_on B" by auto

	lemma fid_on_vunion: "fid_on (A \<union>\<^sub>\<circ> B) = fid_on A \<union>\<^sub>\<circ> fid_on B" by auto

	lemma fid_on_vdiff: "fid_on (A -\<^sub>\<circ> B) = fid_on A -\<^sub>\<circ> fid_on B" by auto


	text\<open>Special properties.\<close>

	lemma fid_on_vsubset_vcpower: "fid_on A \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>" by force


	subsubsection\<open>Constant function\<close>

	definition fconst_on :: "V \<Rightarrow> V \<Rightarrow> V"
	where "fconst_on A c = set {[a, c]\<^sub>\<circ> \| a. a \<in>\<^sub>\<circ> A}"

	lemma small_fconst_on[simp]: "small {[a, c]\<^sub>\<circ> \| a. a \<in>\<^sub>\<circ> A}"
	by (rule down[of _ \<open>A \<times>\<^sub>\<bullet> set {c}\<close>]) blast


	text\<open>Rules.\<close>

	lemma fconst_onI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> fconst_on A c"
	using assms unfolding fconst_on_def by simp

	lemma fconst_onD[dest!]:
	assumes "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> fconst_on A c"
	shows "a \<in>\<^sub>\<circ> A"
	using assms unfolding fconst_on_def by simp

	lemma fconst_onE[elim!]:
	assumes "x \<in>\<^sub>\<circ> fconst_on A c"
	obtains a where "a \<in>\<^sub>\<circ> A" and "x = [a, c]\<^sub>\<circ>"
	using assms unfolding fconst_on_def by auto

	lemma fconst_on_iff: "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> fconst_on A c \<longleftrightarrow> a \<in>\<^sub>\<circ> A" by auto


	text\<open>Set operations.\<close>

	lemma fconst_on_vempty[simp]: "fconst_on 0 c = 0"
	unfolding fconst_on_def by auto

	lemma fconst_on_vsingleton[simp]: "fconst_on (set {a}) c = set {[a, c]\<^sub>\<circ>}"
	by auto

	lemma fconst_on_vdoubleton: "fconst_on (set {a, b}) c = set {[a, c]\<^sub>\<circ>, [b, c]\<^sub>\<circ>}"
	by force

	lemma fconst_on_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "fconst_on A c \<subseteq>\<^sub>\<circ> fconst_on B c"
	using assms by auto

	lemma fconst_on_vinsert:
	"(vinsert [a, c]\<^sub>\<circ> (fconst_on A c)) = (fconst_on (vinsert a A) c)"
	by auto

	lemma fconst_on_vintersection:
	"fconst_on (A \<inter>\<^sub>\<circ> B) c = fconst_on A c \<inter>\<^sub>\<circ> fconst_on B c"
	by auto

	lemma fconst_on_vunion: "fconst_on (A \<union>\<^sub>\<circ> B) c = fconst_on A c \<union>\<^sub>\<circ> fconst_on B c"
	by auto

	lemma fconst_on_vdiff: "fconst_on (A -\<^sub>\<circ> B) c = fconst_on A c -\<^sub>\<circ> fconst_on B c"
	by auto


	text\<open>Special properties.\<close>

	lemma fconst_on_eq_ftimes: "fconst_on A c = A \<times>\<^sub>\<bullet> set {c}" by blast


	subsubsection\<open>Composition\<close>

	definition fcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<circ>\<^sub>\<bullet>\<close> 75)
	where "r \<circ>\<^sub>\<bullet> s = set {[a, c]\<^sub>\<circ> \| a c. \<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s \<and> [b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	notation fcomp (infixr "\<circ>\<^sub>\<bullet>" 75)

	lemma fcomp_small[simp]: "small {[a, c]\<^sub>\<circ> \| a c. \<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s \<and> [b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	(is \<open>small ?s\<close>)
	proof-
	define comp' where "comp' = (\<lambda>\<langle>ab, cd\<rangle>. [ab\<lparr>0\<^sub>\<nat>\<rparr>, cd\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
	have "small (elts (vpairs (s \<times>\<^sub>\<circ> r)))" by simp
	then have small_comp: "small (comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r)))" by simp
	have ss: "?s \<subseteq> (comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r)))"
	proof
	fix x assume "x \<in> ?s"
	then obtain a b c where x_def: "x = [a, c]\<^sub>\<circ>"
	and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s"
	and "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	by auto
	then have abbc: "\<langle>[a, b]\<^sub>\<circ>, [b, c]\<^sub>\<circ>\<rangle> \<in>\<^sub>\<circ> vpairs (s \<times>\<^sub>\<circ> r)"
	by (simp add: vpairs_iff_elts)
	have x_def': "x = comp' \<langle>[a, b]\<^sub>\<circ>, [b, c]\<^sub>\<circ>\<rangle>"
	unfolding comp'_def x_def by (auto simp: nat_omega_simps)
	then show "x \<in> comp' ` elts (vpairs (s \<times>\<^sub>\<circ> r))"
	unfolding x_def' using abbc by auto
	qed
	with small_comp show ?thesis by (meson smaller_than_small)
	qed


	text\<open>Rules.\<close>

	lemma fcompI[intro]:
	assumes "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s"
	shows "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<bullet> s"
	using assms unfolding fcomp_def by auto

	lemma fcompD[dest]:
	assumes "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<circ>\<^sub>\<bullet> s"
	shows "\<exists>b. [b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s"
	using assms unfolding fcomp_def by auto

	lemma fcompE[elim]:
	assumes "ac \<in>\<^sub>\<circ> r \<circ>\<^sub>\<bullet> s"
	obtains a b c where "ac = [a, c]\<^sub>\<circ>" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> s" and "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fcomp_def by clarsimp


	text\<open>Elementary properties.\<close>

	lemma fcomp_assoc: "(r \<circ>\<^sub>\<bullet> s) \<circ>\<^sub>\<bullet> t = r \<circ>\<^sub>\<bullet> (s \<circ>\<^sub>\<bullet> t)" by fast


	text\<open>Set operations.\<close>

	lemma fcomp_vempty_left[simp]: "0 \<circ>\<^sub>\<bullet> r = 0" unfolding vcomp_def by force

	lemma fcomp_vempty_right[simp]: "r \<circ>\<^sub>\<bullet> 0 = 0" unfolding vcomp_def by force

	lemma fcomp_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "s' \<subseteq>\<^sub>\<circ> s"
	shows "r' \<circ>\<^sub>\<bullet> s' \<subseteq>\<^sub>\<circ> r \<circ>\<^sub>\<bullet> s"
	using assms by force

	lemma fcomp_vinsert_left[simp]:
	"vinsert ([a, b]\<^sub>\<circ>) s \<circ>\<^sub>\<bullet> r = (set {[a, b]\<^sub>\<circ>} \<circ>\<^sub>\<bullet> r) \<union>\<^sub>\<circ> (s \<circ>\<^sub>\<bullet> r)"
	by auto

	lemma fcomp_vinsert_right[simp]:
	"r \<circ>\<^sub>\<bullet> vinsert [a, b]\<^sub>\<circ> s = (r \<circ>\<^sub>\<bullet> set {[a, b]\<^sub>\<circ>}) \<union>\<^sub>\<circ> (r \<circ>\<^sub>\<bullet> s)"
	by auto

	lemma fcomp_vunion_left[simp]: "(s \<union>\<^sub>\<circ> t) \<circ>\<^sub>\<bullet> r = (s \<circ>\<^sub>\<bullet> r) \<union>\<^sub>\<circ> (t \<circ>\<^sub>\<bullet> r)" by auto

	lemma fcomp_vunion_right[simp]: "r \<circ>\<^sub>\<bullet> (s \<union>\<^sub>\<circ> t) = (r \<circ>\<^sub>\<bullet> s) \<union>\<^sub>\<circ> (r \<circ>\<^sub>\<bullet> t)" by auto


	text\<open>Connections.\<close>

	-lemma fcomp_fid_on_idem[simp]: "fid_on A \<circ>\<^sub>\<bullet> fid_on A = fid_on A" by auto
	+lemma fcomp_fid_on_idem[simp]: "fid_on A \<circ>\<^sub>\<bullet> fid_on A = fid_on A" by force

	-lemma fcomp_fid_on[simp]: "fid_on A \<circ>\<^sub>\<bullet> fid_on B = fid_on (A \<inter>\<^sub>\<circ> B)" by auto
	+lemma fcomp_fid_on[simp]: "fid_on A \<circ>\<^sub>\<bullet> fid_on B = fid_on (A \<inter>\<^sub>\<circ> B)" by force

	lemma fcomp_fconst_on_fid_on[simp]: "fconst_on A c \<circ>\<^sub>\<bullet> fid_on A = fconst_on A c"
	by auto


	text\<open>Special properties.\<close>

	lemma fcomp_vsubset_vtimes:
	assumes "r \<subseteq>\<^sub>\<circ> B \<times>\<^sub>\<bullet> C" and "s \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	shows "r \<circ>\<^sub>\<bullet> s \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> C"
	using assms by blast

	lemma fcomp_obtain_middle[elim]:
	assumes "[a, c]\<^sub>\<circ> \<in>\<^sub>\<circ> f \<circ>\<^sub>\<bullet> g"
	obtains b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> g" and "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> f"
	using assms by auto


	subsubsection\<open>Converse relation\<close>

	definition fconverse :: "V \<Rightarrow> V" (\<open>(_\<inverse>\<^sub>\<bullet>)\<close> [1000] 999)
	where "r\<inverse>\<^sub>\<bullet> = set {[b, a]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"

	lemma fconverse_small[simp]: "small {[b, a]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	have eq:
	"{[b, a]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} = (\<lambda>x. [x\<lparr>1\<^sub>\<nat>\<rparr>, x\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>) ` elts (fpairs r)"
	proof(rule subset_antisym; rule subsetI, unfold mem_Collect_eq)
	fix x assume "x \<in> (\<lambda>x. [x\<lparr>1\<^sub>\<nat>\<rparr>, x\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>) ` elts (fpairs r)"
	then obtain a b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> fpairs r"
	and "x = (\<lambda>x. [x\<lparr>1\<^sub>\<nat>\<rparr>, x\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>) [a, b]\<^sub>\<circ>"
	by blast
	then show "\<exists>a b. x = [b, a]\<^sub>\<circ> \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by (auto simp: nat_omega_simps)
	qed (use image_iff fpairs_iff_elts in \<open>fastforce simp: nat_omega_simps\<close>)
	show ?thesis unfolding eq by (rule replacement) auto
	qed


	text\<open>Rules.\<close>

	lemma fconverseI[sym, intro!]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet>"
	using assms unfolding fconverse_def by simp

	lemma fconverseD[sym, dest]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet>"
	shows "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fconverse_def by simp

	lemma fconverseE[elim!]:
	assumes "x \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet>"
	obtains a b where "x = [b, a]\<^sub>\<circ>" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fconverse_def by auto

	lemma fconverse_iff: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet> \<longleftrightarrow> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto


	text\<open>Set operations.\<close>

	lemma fconverse_vempty[simp]: "0\<inverse>\<^sub>\<bullet> = 0" by auto

	lemma fconverse_vsingleton: "(set {[a, b]\<^sub>\<circ>})\<inverse>\<^sub>\<bullet> = set {[b, a]\<^sub>\<circ>}" by auto

	lemma fconverse_vdoubleton: "(set {[a, b]\<^sub>\<circ>, [c, d]\<^sub>\<circ>})\<inverse>\<^sub>\<bullet> = set {[b, a]\<^sub>\<circ>, [d, c]\<^sub>\<circ>}"
	by force

	lemma fconverse_vinsert: "(vinsert [a, b]\<^sub>\<circ> r)\<inverse>\<^sub>\<bullet> = vinsert [b, a]\<^sub>\<circ> (r\<inverse>\<^sub>\<bullet>)" by auto

	lemma fconverse_vintersection: "(r \<inter>\<^sub>\<circ> s)\<inverse>\<^sub>\<bullet> = r\<inverse>\<^sub>\<bullet> \<inter>\<^sub>\<circ> s\<inverse>\<^sub>\<bullet>" by auto

	lemma fconverse_vunion: "(r \<union>\<^sub>\<circ> s)\<inverse>\<^sub>\<bullet> = r\<inverse>\<^sub>\<bullet> \<union>\<^sub>\<circ> s\<inverse>\<^sub>\<bullet>" by auto


	text\<open>Connections.\<close>

	lemma fconverse_fid_on[simp]: "(fid_on A)\<inverse>\<^sub>\<bullet> = fid_on A" by auto

	lemma fconverse_fconst_on[simp]: "(fconst_on A c)\<inverse>\<^sub>\<bullet> = set {c} \<times>\<^sub>\<bullet> A" by blast

	lemma fconverse_fcomp: "(r \<circ>\<^sub>\<bullet> s)\<inverse>\<^sub>\<bullet> = s\<inverse>\<^sub>\<bullet> \<circ>\<^sub>\<bullet> r\<inverse>\<^sub>\<bullet>" by auto

	lemma fconverse_ftimes: "(A \<times>\<^sub>\<bullet> B)\<inverse>\<^sub>\<bullet> = (B \<times>\<^sub>\<bullet> A)" by auto


	text\<open>Special properties.\<close>

	lemma fconverse_pred:
	assumes "small {[a, b]\<^sub>\<circ> \| a b. P a b}"
	shows "(set {[a, b]\<^sub>\<circ> \| a b. P a b})\<inverse>\<^sub>\<bullet> = set {[b, a]\<^sub>\<circ> \| a b. P a b}"
	using assms unfolding fconverse_def by simp


	subsubsection\<open>Left restriction\<close>

	definition flrestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>l\<^sub>\<bullet>\<close> 80)
	where "r \<restriction>\<^sup>l\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ> \| a b. a \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"

	lemma flrestriction_small[simp]: "small {[a, b]\<^sub>\<circ> \| a b. a \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma flrestrictionI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<bullet> A"
	using assms unfolding flrestriction_def by simp

	lemma flrestrictionD[dest]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding flrestriction_def by auto

	lemma flrestrictionE[elim!]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<bullet> A"
	obtains a b where "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding flrestriction_def by auto


	text\<open>Set operations.\<close>

	lemma flrestriction_on_vempty[simp]: "r \<restriction>\<^sup>l\<^sub>\<bullet> 0 = 0" by auto

	lemma flrestriction_vempty[simp]: "0 \<restriction>\<^sup>l\<^sub>\<bullet> A = 0" by auto

	lemma flrestriction_vsingleton_in[simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sup>l\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ>}"
	using assms by auto

	lemma flrestriction_vsingleton_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sup>l\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma flrestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sup>l\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>l\<^sub>\<bullet> B"
	using assms by auto

	lemma flrestriction_vinsert_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sup>l\<^sub>\<bullet> A"
	using assms by auto

	lemma flrestriction_vinsert_in:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sup>l\<^sub>\<bullet> A = vinsert [a, b]\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<bullet> A)"
	using assms by auto

	lemma flrestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sup>l\<^sub>\<bullet> A \<inter>\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<bullet> A" by auto

	lemma flrestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sup>l\<^sub>\<bullet> A \<union>\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<bullet> A" by auto

	lemma flrestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sup>l\<^sub>\<bullet> A -\<^sub>\<circ> s \<restriction>\<^sup>l\<^sub>\<bullet> A" by auto


	text\<open>Connections.\<close>

	lemma flrestriction_fid_on[simp]: "(fid_on A) \<restriction>\<^sup>l\<^sub>\<bullet> B = fid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma flrestriction_fconst_on: "(fconst_on A c) \<restriction>\<^sup>l\<^sub>\<bullet> B = (fconst_on B c) \<restriction>\<^sup>l\<^sub>\<bullet> A"
	by auto

	lemma flrestriction_fconst_on_commute:
	assumes "x \<in>\<^sub>\<circ> fconst_on A c \<restriction>\<^sup>l\<^sub>\<bullet> B"
	shows "x \<in>\<^sub>\<circ> fconst_on B c \<restriction>\<^sup>l\<^sub>\<bullet> A"
	using assms by auto

	lemma flrestriction_fcomp[simp]: "(r \<circ>\<^sub>\<bullet> s) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<circ>\<^sub>\<bullet> (s \<restriction>\<^sup>l\<^sub>\<bullet> A)" by auto


	text\<open>Previous connections.\<close>

	lemma fcomp_rel_fid_on[simp]: "r \<circ>\<^sub>\<bullet> fid_on A = r \<restriction>\<^sup>l\<^sub>\<bullet> A" by auto

	lemma fcomp_fconst_on:
	"r \<circ>\<^sub>\<bullet> (fconst_on A c) = (r \<restriction>\<^sup>l\<^sub>\<bullet> set {c}) \<circ>\<^sub>\<bullet> (fconst_on A c)"
	by auto


	text\<open>Special properties.\<close>

	lemma flrestriction_vsubset_fpairs: "r \<restriction>\<^sup>l\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> fpairs r"
	by (rule vsubsetI) (metis fpairs_iff_elts flrestrictionE)

	lemma flrestriction_vsubset_frel: "r \<restriction>\<^sup>l\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r" by auto


	subsubsection\<open>Right restriction\<close>

	definition frrestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sup>r\<^sub>\<bullet>\<close> 80)
	where "r \<restriction>\<^sup>r\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ> \| a b. b \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"

	lemma frrestriction_small[simp]: "small {[a, b]\<^sub>\<circ> \| a b. b \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma frrestrictionI[intro!]:
	assumes "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<bullet> A"
	using assms unfolding frrestriction_def by simp

	lemma frrestrictionD[dest]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<bullet> A"
	shows "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frrestriction_def by auto

	lemma frrestrictionE[elim!]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<bullet> A"
	obtains a b where "x = [a, b]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frrestriction_def by auto


	text\<open>Set operations.\<close>

	lemma frrestriction_on_vempty[simp]: "r \<restriction>\<^sup>r\<^sub>\<bullet> 0 = 0" by auto

	lemma frrestriction_vempty[simp]: "0 \<restriction>\<^sup>r\<^sub>\<bullet> A = 0" by auto

	lemma frrestriction_vsingleton_in[simp]:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sup>r\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ>}"
	using assms by auto

	lemma frrestriction_vsingleton_nin[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sup>r\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma frrestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sup>r\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sup>r\<^sub>\<bullet> B"
	using assms by auto

	lemma frrestriction_vinsert_nin[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sup>r\<^sub>\<bullet> A"
	using assms by auto

	lemma frrestriction_vinsert_in:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sup>r\<^sub>\<bullet> A = vinsert [a, b]\<^sub>\<circ> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)"
	using assms by auto

	lemma frrestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sup>r\<^sub>\<bullet> A \<inter>\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<bullet> A" by auto

	lemma frrestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sup>r\<^sub>\<bullet> A \<union>\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<bullet> A" by auto

	lemma frrestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sup>r\<^sub>\<bullet> A -\<^sub>\<circ> s \<restriction>\<^sup>r\<^sub>\<bullet> A" by auto


	text\<open>Connections.\<close>

	lemma frrestriction_fid_on[simp]: "(fid_on A) \<restriction>\<^sup>r\<^sub>\<bullet> B = fid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma frrestriction_fconst_on:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "(fconst_on A c) \<restriction>\<^sup>r\<^sub>\<bullet> B = fconst_on A c"
	using assms by auto

	lemma frrestriction_fcomp[simp]: "(r \<circ>\<^sub>\<bullet> s) \<restriction>\<^sup>r\<^sub>\<bullet> A = (r \<restriction>\<^sup>r\<^sub>\<bullet> A) \<circ>\<^sub>\<bullet> s" by auto


	text\<open>Previous connections.\<close>

	lemma fcomp_fid_on_rel[simp]: "fid_on A \<circ>\<^sub>\<bullet> r = r \<restriction>\<^sup>r\<^sub>\<bullet> A" by force

	lemma fcomp_fconst_on_rel: "(fconst_on A c) \<circ>\<^sub>\<bullet> r = (fconst_on A c) \<circ>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)"
	by auto

	lemma flrestriction_fconverse: "r\<inverse>\<^sub>\<bullet> \<restriction>\<^sup>l\<^sub>\<bullet> A = (r \<restriction>\<^sup>r\<^sub>\<bullet> A)\<inverse>\<^sub>\<bullet>" by auto

	lemma frrestriction_fconverse: "r\<inverse>\<^sub>\<bullet> \<restriction>\<^sup>r\<^sub>\<bullet> A = (r \<restriction>\<^sup>l\<^sub>\<bullet> A)\<inverse>\<^sub>\<bullet>" by auto


	text\<open>Special properties.\<close>

	lemma frrestriction_vsubset_rel: "r \<restriction>\<^sup>r\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r" by auto

	lemma frrestriction_vsubset_vpairs: "r \<restriction>\<^sup>r\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> fpairs r" by auto


	subsubsection\<open>Restriction\<close>

	definition frestriction :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<restriction>\<^sub>\<bullet>\<close> 80)
	where "r \<restriction>\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ> \| a b. a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"

	lemma frestriction_small[simp]:
	"small {[a, b]\<^sub>\<circ> \| a b. a \<in>\<^sub>\<circ> A \<and> b \<in>\<^sub>\<circ> A \<and> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) auto


	text\<open>Rules.\<close>

	lemma frestrictionI[intro!]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<bullet> A"
	using assms unfolding frestriction_def by simp

	lemma frestrictionD[dest]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frestriction_def by auto

	lemma frestrictionE[elim!]:
	assumes "x \<in>\<^sub>\<circ> r \<restriction>\<^sub>\<bullet> A"
	obtains a b where "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A" and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frestriction_def by clarsimp


	text\<open>Set operations.\<close>

	lemma frestriction_on_vempty[simp]: "r \<restriction>\<^sub>\<bullet> 0 = 0" by auto

	lemma frestriction_vempty[simp]: "0 \<restriction>\<^sub>\<bullet> A = 0" by auto

	lemma frestriction_vsingleton_in[simp]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sub>\<bullet> A = set {[a, b]\<^sub>\<circ>}"
	using assms by auto

	lemma frestriction_vsingleton_nin_left[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma frestriction_vsingleton_nin_right[simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} \<restriction>\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma frestriction_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "r \<restriction>\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r \<restriction>\<^sub>\<bullet> B"
	using assms by auto

	lemma frestriction_vinsert_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A" and "b \<notin>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A"
	using assms by auto

	lemma frestriction_vinsert_in:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "(vinsert [a, b]\<^sub>\<circ> r) \<restriction>\<^sub>\<bullet> A = vinsert [a, b]\<^sub>\<circ> (r \<restriction>\<^sub>\<bullet> A)"
	using assms by auto

	lemma frestriction_vintersection: "(r \<inter>\<^sub>\<circ> s) \<restriction>\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A \<inter>\<^sub>\<circ> s \<restriction>\<^sub>\<bullet> A" by auto

	lemma frestriction_vunion: "(r \<union>\<^sub>\<circ> s) \<restriction>\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A \<union>\<^sub>\<circ> s \<restriction>\<^sub>\<bullet> A" by auto

	lemma frestriction_vdiff: "(r -\<^sub>\<circ> s) \<restriction>\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A -\<^sub>\<circ> s \<restriction>\<^sub>\<bullet> A" by auto


	text\<open>Connections.\<close>

	lemma fid_on_frestriction[simp]: "(fid_on A) \<restriction>\<^sub>\<bullet> B = fid_on (A \<inter>\<^sub>\<circ> B)" by auto

	lemma frestriction_fconst_on_ex:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "(fconst_on A c) \<restriction>\<^sub>\<bullet> B = fconst_on (A \<inter>\<^sub>\<circ> B) c"
	using assms by auto

	lemma frestriction_fconst_on_nex:
	assumes "c \<notin>\<^sub>\<circ> B"
	shows "(fconst_on A c) \<restriction>\<^sub>\<bullet> B = 0"
	using assms by auto

	lemma frestriction_fcomp[simp]: "(r \<circ>\<^sub>\<bullet> s) \<restriction>\<^sub>\<bullet> A = (r \<restriction>\<^sup>r\<^sub>\<bullet> A) \<circ>\<^sub>\<bullet> (s \<restriction>\<^sup>l\<^sub>\<bullet> A)" by auto

	lemma frestriction_fconverse: "r\<inverse>\<^sub>\<bullet> \<restriction>\<^sub>\<bullet> A = (r \<restriction>\<^sub>\<bullet> A)\<inverse>\<^sub>\<bullet>" by auto


	text\<open>Previous connections.\<close>

	lemma frrestriction_flrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<bullet> A) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A" by auto

	lemma flrestriction_frrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<bullet> A) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A" by auto

	lemma frestriction_flrestriction[simp]: "(r \<restriction>\<^sub>\<bullet> A) \<restriction>\<^sup>l\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A" by auto

	lemma frestriction_frrestriction[simp]: "(r \<restriction>\<^sub>\<bullet> A) \<restriction>\<^sup>r\<^sub>\<bullet> A = r \<restriction>\<^sub>\<bullet> A" by auto


	text\<open>Special properties.\<close>

	lemma frestriction_vsubset_fpairs: "r \<restriction>\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> fpairs r" by auto

	lemma frestriction_vsubset_ftimes: "r \<restriction>\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>" by force

	lemma frestriction_vsubset_rel: "r \<restriction>\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> r" by auto



	subsection\<open>Properties\<close>


	subsubsection\<open>Domain\<close>

	definition fdomain :: "V \<Rightarrow> V" (\<open>\<D>\<^sub>\<bullet>\<close>)
	where "\<D>\<^sub>\<bullet> r = set {a. \<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	notation fdomain (\<open>\<D>\<^sub>\<bullet>\<close>)

	lemma fdomain_small[simp]: "small {a. \<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{a. \<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} \<subseteq> (\<lambda>x. x\<lparr>0\<^sub>\<nat>\<rparr>) ` elts r"
	using image_iff by force
	have small: "small ((\<lambda>x. x\<lparr>0\<^sub>\<nat>\<rparr>) ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma fdomainI[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r"
	using assms unfolding fdomain_def by auto

	lemma fdomainD[dest]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r"
	shows "\<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fdomain_def by auto

	lemma fdomainE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r"
	obtains b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding fdomain_def by clarsimp

	lemma fdomain_iff: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r \<longleftrightarrow> (\<exists>y. [a, y]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma fdomain_vempty[simp]: "\<D>\<^sub>\<bullet> 0 = 0" by force

	lemma fdomain_vsingleton[simp]: "\<D>\<^sub>\<bullet> (set {[a, b]\<^sub>\<circ>}) = set {a}" by auto

	lemma fdomain_vdoubleton[simp]: "\<D>\<^sub>\<bullet> (set {[a, b]\<^sub>\<circ>, [c, d]\<^sub>\<circ>}) = set {a, c}"
	by force

	lemma fdomain_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "\<D>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<bullet> s"
	using assms by blast

	lemma fdomain_vinsert[simp]: "\<D>\<^sub>\<bullet> (vinsert [a, b]\<^sub>\<circ> r) = vinsert a (\<D>\<^sub>\<bullet> r)"
	by force

	lemma fdomain_vunion: "\<D>\<^sub>\<bullet> (A \<union>\<^sub>\<circ> B) = \<D>\<^sub>\<bullet> A \<union>\<^sub>\<circ> \<D>\<^sub>\<bullet> B" by force

	lemma fdomain_vintersection_vsubset: "\<D>\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<bullet> A \<inter>\<^sub>\<circ> \<D>\<^sub>\<bullet> B" by auto

	lemma fdomain_vdiff_vsubset: "\<D>\<^sub>\<bullet> A -\<^sub>\<circ> \<D>\<^sub>\<bullet> B \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<bullet> (A -\<^sub>\<circ> B)" by auto


	text\<open>Connections.\<close>

	lemma fdomain_fid_on[simp]: "\<D>\<^sub>\<bullet> (fid_on A) = A" by force

	lemma fdomain_fconst_on[simp]: "\<D>\<^sub>\<bullet> (fconst_on A c) = A" by force

	lemma fdomain_flrestriction: "\<D>\<^sub>\<bullet> (r \<restriction>\<^sup>l\<^sub>\<bullet> A) = \<D>\<^sub>\<bullet> r \<inter>\<^sub>\<circ> A" by auto


	text\<open>Special properties.\<close>

	lemma fdomain_vsubset_ftimes:
	assumes "fpairs r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	shows "\<D>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> A"
	using assms by blast

	lemma fdomain_vsubset_VUnion2: "\<D>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r))"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r"
	then obtain y where "[x, y]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto
	then have "set {\<langle>0\<^sub>\<nat>, x\<rangle>, \<langle>1\<^sub>\<nat>, y\<rangle>} \<in>\<^sub>\<circ> r" unfolding vcons_vdoubleton by simp
	with insert_commute have "\<langle>0\<^sub>\<nat>, x\<rangle> \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>r" by auto
	then show "x \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r))"
	unfolding vpair_def
	by (metis (full_types) VUnion_iff insert_commute vintersection_vdoubleton)
	qed


	subsubsection\<open>Range\<close>

	definition frange :: "V \<Rightarrow> V" (\<open>\<R>\<^sub>\<bullet>\<close>)
	where "frange r = set {b. \<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	notation frange (\<open>\<R>\<^sub>\<bullet>\<close>)

	lemma frange_small[simp]: "small {b. \<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{b. \<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} \<subseteq> (\<lambda>x. x\<lparr>1\<^sub>\<nat>\<rparr>) ` elts r"
	using image_iff by (fastforce simp: nat_omega_simps)
	have small: "small ((\<lambda>x. x\<lparr>1\<^sub>\<nat>\<rparr>) ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma frangeI[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "b \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	using assms unfolding frange_def by auto

	lemma frangeD[dest]:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	shows "\<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frange_def by simp

	lemma frangeE[elim!]:
	assumes "b \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	obtains a where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	using assms unfolding frange_def by clarsimp

	lemma frange_iff: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r \<longleftrightarrow> (\<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma frange_vempty[simp]: "\<R>\<^sub>\<bullet> 0 = 0" by auto

	lemma frange_vsingleton[simp]: "\<R>\<^sub>\<bullet> (set {[a, b]\<^sub>\<circ>}) = set {b}" by auto

	lemma frange_vdoubleton[simp]: "\<R>\<^sub>\<bullet> (set {[a, b]\<^sub>\<circ>, [c, d]\<^sub>\<circ>}) = set {b, d}"
	by force

	lemma frange_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "\<R>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<bullet> s"
	using assms by force

	lemma frange_vinsert[simp]: "\<R>\<^sub>\<bullet> (vinsert [a, b]\<^sub>\<circ> r) = vinsert b (\<R>\<^sub>\<bullet> r)" by auto

	lemma frange_vunion: "\<R>\<^sub>\<bullet> (r \<union>\<^sub>\<circ> s) = \<R>\<^sub>\<bullet> r \<union>\<^sub>\<circ> \<R>\<^sub>\<bullet> s" by auto

	lemma frange_vintersection_vsubset: "\<R>\<^sub>\<bullet> (r \<inter>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<bullet> r \<inter>\<^sub>\<circ> \<R>\<^sub>\<bullet> s" by auto

	lemma frange_vdiff_vsubset: "\<R>\<^sub>\<bullet> r -\<^sub>\<circ> \<R>\<^sub>\<bullet> s \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<bullet> (r -\<^sub>\<circ> s)" by auto


	text\<open>Connections.\<close>

	lemma frange_fid_on[simp]: "\<R>\<^sub>\<bullet> (fid_on A) = A" by force

	lemma frange_fconst_on_vempty[simp]: "\<R>\<^sub>\<bullet> (fconst_on 0 c) = 0" by auto

	lemma frange_fconst_on_ne[simp]:
	assumes "A \<noteq> 0"
	shows "\<R>\<^sub>\<bullet> (fconst_on A c) = set {c}"
	using assms by force

	lemma frange_vrrestriction: "\<R>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A) = \<R>\<^sub>\<bullet> r \<inter>\<^sub>\<circ> A" by auto


	text\<open>Previous connections\<close>

	lemma fdomain_fconverse[simp]: "\<D>\<^sub>\<bullet> (r\<inverse>\<^sub>\<bullet>) = \<R>\<^sub>\<bullet> r" by auto

	lemma frange_fconverse[simp]: "\<R>\<^sub>\<bullet> (r\<inverse>\<^sub>\<bullet>) = \<D>\<^sub>\<bullet> r" by force


	text\<open>Special properties.\<close>

	lemma frange_iff_vdomain: "b \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>\<D>\<^sub>\<bullet> r. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto

	lemma frange_vsubset_ftimes:
	assumes "fpairs r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	shows "\<R>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> B"
	using assms by blast

	lemma fpairs_vsubset_fdomain_frange[simp]: "fpairs r \<subseteq>\<^sub>\<circ> (\<D>\<^sub>\<bullet> r) \<times>\<^sub>\<bullet> (\<R>\<^sub>\<bullet> r)"
	by blast

	lemma frange_vsubset_VUnion2: "\<R>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r))"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	then obtain x where "[x, y]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto
	then have "set {\<langle>0\<^sub>\<nat>, x\<rangle>, \<langle>1\<^sub>\<nat>, y\<rangle>} \<in>\<^sub>\<circ> r" unfolding vcons_vdoubleton by simp
	with insert_commute have "\<langle>1\<^sub>\<nat>, y\<rangle> \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>r" by auto
	then show "y \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r))"
	unfolding vpair_def
	by (metis (full_types) VUnion_iff insert_commute vintersection_vdoubleton)
	qed


	subsubsection\<open>Field\<close>

	definition ffield :: "V \<Rightarrow> V"
	where "ffield r = \<D>\<^sub>\<bullet> r \<union>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"

	abbreviation app_ffield :: "V \<Rightarrow> V" (\<open>\<F>\<^sub>\<bullet>\<close>)
	where "\<F>\<^sub>\<bullet> r \<equiv> ffield r"


	text\<open>Rules.\<close>

	lemma ffieldI1[intro]:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r \<union>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	shows "a \<in>\<^sub>\<circ> ffield r"
	using assms unfolding ffield_def by simp

	lemma ffieldI2[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "a \<in>\<^sub>\<circ> ffield r"
	using assms by auto

	lemma ffieldI3[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "b \<in>\<^sub>\<circ> ffield r"
	using assms by auto

	lemma ffieldD[intro]:
	assumes "a \<in>\<^sub>\<circ> ffield r"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r \<union>\<^sub>\<circ> \<R>\<^sub>\<bullet> r"
	using assms unfolding ffield_def by simp

	lemma ffieldE[elim]:
	assumes "a \<in>\<^sub>\<circ> ffield r" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> r \<union>\<^sub>\<circ> \<R>\<^sub>\<bullet> r \<Longrightarrow> P"
	shows P
	using assms by (auto dest: ffieldD)

	lemma ffield_pair[elim]:
	assumes "a \<in>\<^sub>\<circ> ffield r"
	obtains b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<or> [b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r "
	using assms by auto

	lemma ffield_iff: "a \<in>\<^sub>\<circ> ffield r \<longleftrightarrow> (\<exists>b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<or> [b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma ffield_vempty[simp]: "ffield 0 = 0" by force

	lemma ffield_vsingleton[simp]: "ffield (set {[a, b]\<^sub>\<circ>}) = set {a, b}" by force

	lemma ffield_vdoubleton[simp]:
	"ffield (set {[a, b]\<^sub>\<circ>, [c, d]\<^sub>\<circ>}) = set {a, b, c, d}"
	by force

	lemma ffield_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "ffield r \<subseteq>\<^sub>\<circ> ffield s"
	using assms by fastforce

	lemma ffield_vinsert[simp]:
	"ffield (vinsert [a, b]\<^sub>\<circ> r) = set {a, b} \<union>\<^sub>\<circ> (ffield r)"
	apply (intro vsubset_antisym; intro vsubsetI)
	subgoal by auto
	subgoal by (metis ffield_iff vinsert_iff vinsert_vinsert)
	done

	lemma ffield_vunion[simp]: "ffield (r \<union>\<^sub>\<circ> s) = ffield r \<union>\<^sub>\<circ> ffield s"
	unfolding ffield_def by auto


	text\<open>Connections.\<close>

	lemma fid_on_ffield[simp]: "ffield (fid_on A) = A" by force

	lemma fconst_on_ffield_ne[intro, simp]:
	assumes "A \<noteq> 0"
	shows "ffield (fconst_on A c) = vinsert c A"
	using assms by force

	lemma fconst_on_ffield_vempty[simp]: "ffield (fconst_on 0 c) = 0" by auto

	lemma ffield_fconverse[simp]: "ffield (r\<inverse>\<^sub>\<bullet>) = ffield r" by force


	text\<open>Special properties.\<close>

	lemma ffield_vsubset_VUnion2: "\<F>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r))"
	using fdomain_vsubset_VUnion2 frange_vsubset_VUnion2 by (auto simp: ffield_def)


	subsubsection\<open>Image\<close>

	definition fimage :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>`\<^sub>\<bullet>\<close> 90)
	where "r `\<^sub>\<bullet> A = \<R>\<^sub>\<bullet> (r \<restriction>\<^sup>l\<^sub>\<bullet> A)"
	notation fimage (infixr "`\<^sub>\<bullet>" 90)

	lemma fimage_small[simp]: "small {b. \<exists>a\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	from image_iff ord_of_nat_succ_vempty have ss:
	"{b. \<exists>a\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} \<subseteq> (\<lambda>x. x\<lparr>1\<^sub>\<nat>\<rparr>) ` elts r"
	by fastforce
	have small: "small ((\<lambda>x. x\<lparr>1\<^sub>\<nat>\<rparr>) ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma fimageI1:
	assumes "x \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> (r \<restriction>\<^sup>l\<^sub>\<bullet> A)"
	shows "x \<in>\<^sub>\<circ> r `\<^sub>\<bullet> A"
	using assms unfolding fimage_def by simp

	lemma fimageI2[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	shows "b \<in>\<^sub>\<circ> r `\<^sub>\<bullet> A"
	using assms fimageI1 by auto

	lemma fimageD[dest]:
	assumes "x \<in>\<^sub>\<circ> r `\<^sub>\<bullet> A"
	shows "x \<in>\<^sub>\<circ> \<R>\<^sub>\<bullet> (r \<restriction>\<^sup>l\<^sub>\<bullet> A)"
	using assms unfolding fimage_def by simp

	lemma fimageE[elim]:
	assumes "b \<in>\<^sub>\<circ> r `\<^sub>\<bullet> A"
	obtains a where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" and "a \<in>\<^sub>\<circ> A"
	using assms unfolding fimage_def by auto

	lemma fimage_iff: "b \<in>\<^sub>\<circ> r `\<^sub>\<bullet> A \<longleftrightarrow> (\<exists>a\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto


	text\<open>Set operations.\<close>

	lemma fimage_vempty[simp]: "0 `\<^sub>\<bullet> A = 0" by force

	lemma fimage_of_vempty[simp]: "r `\<^sub>\<bullet> 0 = 0" by force

	lemma fimage_vsingleton_in[intro, simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} `\<^sub>\<bullet> A = set {b}"
	using assms by auto

	lemma fimage_vsingleton_nin[intro, simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} `\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma fimage_vsingleton_vinsert[intro, simp]:
	"set {[a, b]\<^sub>\<circ>} `\<^sub>\<bullet> vinsert a A = set {b}"
	by auto

	lemma fimage_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "A' \<subseteq>\<^sub>\<circ> A"
	shows "(r' `\<^sub>\<bullet> A') \<subseteq>\<^sub>\<circ> (r `\<^sub>\<bullet> A)"
	using assms by fastforce

	lemma fimage_vinsert: "r `\<^sub>\<bullet> (vinsert a A) = r `\<^sub>\<bullet> set {a} \<union>\<^sub>\<circ> r `\<^sub>\<bullet> A" by auto

	lemma fimage_vunion_left: "(r \<union>\<^sub>\<circ> s) `\<^sub>\<bullet> A = r `\<^sub>\<bullet> A \<union>\<^sub>\<circ> s `\<^sub>\<bullet> A" by auto

	lemma fimage_vunion_right: "r `\<^sub>\<bullet> (A \<union>\<^sub>\<circ> B) = r `\<^sub>\<bullet> A \<union>\<^sub>\<circ> r `\<^sub>\<bullet> B" by auto

	lemma fimage_vintersection: "r `\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> r `\<^sub>\<bullet> A \<inter>\<^sub>\<circ> r `\<^sub>\<bullet> B" by auto

	lemma fimage_vdiff: "r `\<^sub>\<bullet> A -\<^sub>\<circ> r `\<^sub>\<bullet> B \<subseteq>\<^sub>\<circ> r `\<^sub>\<bullet> (A -\<^sub>\<circ> B)" by auto


	text\<open>Special properties.\<close>

	lemma fimage_vsingleton_iff[iff]: "b \<in>\<^sub>\<circ> r `\<^sub>\<bullet> set {a} \<longleftrightarrow> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" by auto

	lemma fimage_is_vempty[iff]: "r `\<^sub>\<bullet> A = 0 \<longleftrightarrow> vdisjnt (\<D>\<^sub>\<bullet> r) A" by fastforce


	text\<open>Connections.\<close>

	lemma fid_on_fimage[simp]: "(fid_on A) `\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> B" by force

	lemma fimage_fconst_on_ne[simp]:
	assumes "B \<inter>\<^sub>\<circ> A \<noteq> 0"
	shows "(fconst_on A c) `\<^sub>\<bullet> B = set {c}"
	using assms by auto

	lemma fimage_fconst_on_vempty[simp]:
	assumes "vdisjnt A B"
	shows "(fconst_on A c) `\<^sub>\<bullet> B = 0"
	using assms by auto

	lemma fimage_fconst_on_vsubset_const[simp]: "(fconst_on A c) `\<^sub>\<bullet> B \<subseteq>\<^sub>\<circ> set {c}"
	by auto

	lemma fcomp_frange: "\<R>\<^sub>\<bullet> (r \<circ>\<^sub>\<bullet> s) = r `\<^sub>\<bullet> (\<R>\<^sub>\<bullet> s)" by blast

	lemma fcomp_fimage: "(r \<circ>\<^sub>\<bullet> s) `\<^sub>\<bullet> A = r `\<^sub>\<bullet> (s `\<^sub>\<bullet> A)" by blast

	lemma fimage_flrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<bullet> A) `\<^sub>\<bullet> B = r `\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B)" by auto

	lemma fimage_frrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<bullet> A) `\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> r `\<^sub>\<bullet> B" by auto

	lemma fimage_frestriction[simp]: "(r \<restriction>\<^sub>\<bullet> A) `\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> (r `\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B))" by auto

	lemma fimage_fdomain: "r `\<^sub>\<bullet> \<D>\<^sub>\<bullet> r = \<R>\<^sub>\<bullet> r" by auto

	lemma fimage_eq_imp_fcomp:
	assumes "f `\<^sub>\<bullet> A = g `\<^sub>\<bullet> B"
	shows "(h \<circ>\<^sub>\<bullet> f) `\<^sub>\<bullet> A = (h \<circ>\<^sub>\<bullet> g) `\<^sub>\<bullet> B"
	using assms by (metis fcomp_fimage)


	text\<open>Previous connections.\<close>

	lemma fcomp_rel_fconst_on_ftimes: "r \<circ>\<^sub>\<bullet> (fconst_on A c) = A \<times>\<^sub>\<bullet> (r `\<^sub>\<bullet> set {c})"
	by blast


	text\<open>Further special properties.\<close>

	lemma fimage_vsubset:
	assumes "r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	shows "r `\<^sub>\<bullet> C \<subseteq>\<^sub>\<circ> B"
	using assms by blast

	lemma fimage_set_def: "r `\<^sub>\<bullet> A = set {b. \<exists>a\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	unfolding fimage_def frange_def by auto

	lemma fimage_vsingleton: "r `\<^sub>\<bullet> set {a} = set {b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	have "{b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} \<subseteq> {b. \<exists>a. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}" by auto
	then have [simp]: "small {b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	by (rule smaller_than_small[OF frange_small[of r]])
	show ?thesis by auto
	qed

	lemma fimage_strict_vsubset: "f `\<^sub>\<bullet> A \<subseteq>\<^sub>\<circ> f `\<^sub>\<bullet> \<D>\<^sub>\<bullet> f" by auto


	subsubsection\<open>Inverse image\<close>

	definition finvimage :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>-`\<^sub>\<bullet>\<close> 90)
	where "r -`\<^sub>\<bullet> A = r\<inverse>\<^sub>\<bullet> `\<^sub>\<bullet> A"

	lemma finvimage_small[simp]: "small {a. \<exists>b\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	proof-
	have ss: "{a. \<exists>b\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r} \<subseteq> (\<lambda>x. x\<lparr>0\<^sub>\<nat>\<rparr>) ` elts r"
	using image_iff by fastforce
	have small: "small ((\<lambda>x. x\<lparr>0\<^sub>\<nat>\<rparr>) ` elts r)" by (rule replacement) simp
	show ?thesis by (rule smaller_than_small, rule small, rule ss)
	qed


	text\<open>Rules.\<close>

	lemma finvimageI[intro]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	using assms finvimage_def by auto

	lemma finvimageD[dest]:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)"
	using assms using finvimage_def by auto

	lemma finvimageE[elim]:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	obtains b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> A"
	using assms unfolding finvimage_def by auto

	lemma finvimageI1:
	assumes "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	using assms unfolding fimage_def
	by (simp add: finvimage_def fimageI1 flrestriction_fconverse)

	lemma finvimageD1:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)"
	using assms by fastforce

	lemma finvimageE1:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A " and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A) \<Longrightarrow> P"
	shows P
	using assms by auto

	lemma finvimageI2:
	assumes "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet> `\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	using assms unfolding finvimage_def by simp

	lemma finvimageD2:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A"
	shows "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet> `\<^sub>\<bullet> A"
	using assms unfolding finvimage_def by simp

	lemma finvimageE2:
	assumes "a \<in>\<^sub>\<circ> r -`\<^sub>\<circ> A" and "a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<circ> `\<^sub>\<circ> A \<Longrightarrow> P"
	shows P
	unfolding vimage_def using assms by blast

	lemma finvimage_iff: "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A \<longleftrightarrow> (\<exists>b\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r)" by auto

	lemma finvimage_iff1: "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A \<longleftrightarrow> a \<in>\<^sub>\<circ> \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)" by auto

	lemma finvimage_iff2: "a \<in>\<^sub>\<circ> r -`\<^sub>\<bullet> A \<longleftrightarrow> a \<in>\<^sub>\<circ> r\<inverse>\<^sub>\<bullet> `\<^sub>\<bullet> A" by auto


	text\<open>Set operations.\<close>

	lemma finvimage_vempty[simp]: "0 -`\<^sub>\<bullet> A = 0" by force

	lemma finvimage_of_vempty[simp]: "r -`\<^sub>\<bullet> 0 = 0" by force

	lemma finvimage_vsingleton_in[intro, simp]:
	assumes "b \<in>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} -`\<^sub>\<bullet> A = set {a}"
	using assms by auto

	lemma finvimage_vsingleton_nin[intro, simp]:
	assumes "b \<notin>\<^sub>\<circ> A"
	shows "set {[a, b]\<^sub>\<circ>} -`\<^sub>\<bullet> A = 0"
	using assms by auto

	lemma finvimage_vsingleton_vinsert[intro, simp]:
	"set {[a, b]\<^sub>\<circ>} -`\<^sub>\<bullet> vinsert b A = set {a}"
	by auto

	lemma finvimage_mono:
	assumes "r' \<subseteq>\<^sub>\<circ> r" and "A' \<subseteq>\<^sub>\<circ> A"
	shows "(r' -`\<^sub>\<bullet> A') \<subseteq>\<^sub>\<circ> (r -`\<^sub>\<bullet> A)"
	using assms by fastforce

	lemma finvimage_vinsert: "r -`\<^sub>\<bullet> (vinsert a A) = r -`\<^sub>\<bullet> set {a} \<union>\<^sub>\<circ> r -`\<^sub>\<bullet> A" by auto

	lemma finvimage_vunion_left: "(r \<union>\<^sub>\<circ> s) -`\<^sub>\<bullet> A = r -`\<^sub>\<bullet> A \<union>\<^sub>\<circ> s -`\<^sub>\<bullet> A" by auto

	lemma finvimage_vunion_right: "r -`\<^sub>\<bullet> (A \<union>\<^sub>\<circ> B) = r -`\<^sub>\<bullet> A \<union>\<^sub>\<circ> r -`\<^sub>\<bullet> B" by auto

	lemma finvimage_vintersection: "r -`\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> r -`\<^sub>\<bullet> A \<inter>\<^sub>\<circ> r -`\<^sub>\<bullet> B" by auto

	lemma finvimage_vdiff: "r -`\<^sub>\<bullet> A -\<^sub>\<circ> r -`\<^sub>\<bullet> B \<subseteq>\<^sub>\<circ> r -`\<^sub>\<bullet> (A -\<^sub>\<circ> B)" by auto


	text\<open>Special properties.\<close>

	lemma finvimage_set_def: "r -`\<^sub>\<bullet> A = set {a. \<exists>b\<in>\<^sub>\<circ>A. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}" by fastforce

	lemma finvimage_eq_fdomain_frestriction: "r -`\<^sub>\<bullet> A = \<D>\<^sub>\<bullet> (r \<restriction>\<^sup>r\<^sub>\<bullet> A)" by fastforce

	lemma finvimage_frange[simp]: "r -`\<^sub>\<bullet> \<R>\<^sub>\<bullet> r = \<D>\<^sub>\<bullet> r"
	unfolding invimage_def by force

	lemma finvimage_frange_vsubset[simp]:
	assumes "\<R>\<^sub>\<bullet> r \<subseteq>\<^sub>\<circ> B"
	shows "r -`\<^sub>\<bullet> B = \<D>\<^sub>\<bullet> r"
	using assms unfolding finvimage_def by force


	text\<open>Connections.\<close>

	lemma finvimage_fid_on[simp]: "(fid_on A) -`\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> B" by force

	lemma finvimage_fconst_on_vsubset_fdomain[simp]: "(fconst_on A c) -`\<^sub>\<bullet> B \<subseteq>\<^sub>\<circ> A"
	unfolding finvimage_def by blast

	lemma finvimage_fconst_on_ne[simp]:
	assumes "c \<in>\<^sub>\<circ> B"
	shows "(fconst_on A c) -`\<^sub>\<bullet> B = A"
	by (simp add: assms finvimage_eq_fdomain_frestriction frrestriction_fconst_on)

	lemma finvimage_fconst_on_vempty[simp]:
	assumes "c \<notin>\<^sub>\<circ> B"
	shows "(fconst_on A c) -`\<^sub>\<bullet> B = 0"
	using assms by auto

	lemma finvimage_fcomp: "(g \<circ>\<^sub>\<bullet> f) -`\<^sub>\<bullet> x = f -`\<^sub>\<bullet> (g -`\<^sub>\<bullet> x) "
	by (simp add: finvimage_def fconverse_fcomp fcomp_fimage)

	lemma finvimage_fconverse[simp]: "r\<inverse>\<^sub>\<bullet> -`\<^sub>\<bullet> A = r `\<^sub>\<bullet> A" by auto

	lemma finvimage_flrestriction[simp]: "(r \<restriction>\<^sup>l\<^sub>\<bullet> A) -`\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> r -`\<^sub>\<bullet> B" by auto

	lemma finvimage_frrestriction[simp]: "(r \<restriction>\<^sup>r\<^sub>\<bullet> A) -`\<^sub>\<bullet> B = (r -`\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B))" by auto

	lemma finvimage_frestriction[simp]: "(r \<restriction>\<^sub>\<bullet> A) -`\<^sub>\<bullet> B = A \<inter>\<^sub>\<circ> (r -`\<^sub>\<bullet> (A \<inter>\<^sub>\<circ> B))"
	by blast


	text\<open>Previous connections.\<close>

	lemma fdomain_fcomp[simp]: "\<D>\<^sub>\<bullet> (r \<circ>\<^sub>\<bullet> s) = s -`\<^sub>\<bullet> \<D>\<^sub>\<bullet> r" by force



	subsection\<open>Classification of relations\<close>


	subsubsection\<open>Binary relation\<close>

	locale fbrelation =
	fixes r :: V
	assumes fbrelation[simp]: "fpairs r = r"

	locale fbrelation_pair = r\<^sub>1: fbrelation r\<^sub>1 + r\<^sub>2: fbrelation r\<^sub>2 for r\<^sub>1 r\<^sub>2


	text\<open>Rules.\<close>

	lemma fpairs_eqI[intro!]:
	assumes "\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = [a, b]\<^sub>\<circ>"
	shows "fpairs r = r"
	using assms by auto

	lemma fpairs_eqD[dest]:
	assumes "fpairs r = r"
	shows "\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = [a, b]\<^sub>\<circ>"
	using assms by auto

	lemma fpairs_eqE[elim!]:
	assumes "fpairs r = r" and "(\<And>x. x \<in>\<^sub>\<circ> r \<Longrightarrow> \<exists>a b. x = [a, b]\<^sub>\<circ>) \<Longrightarrow> P"
	shows P
	using assms by auto

	lemmas fbrelationI[intro!] = fbrelation.intro
	lemmas fbrelationD[dest!] = fbrelation.fbrelation

	lemma fbrelationE[elim!]:
	assumes "fbrelation r" and "(fpairs r = r) \<Longrightarrow> P"
	shows P
	using assms unfolding fbrelation_def by auto

	lemma fbrelationE1:
	assumes "fbrelation r" and "x \<in>\<^sub>\<circ> r"
	obtains a b where "x = [a, b]\<^sub>\<circ>"
	using assms by auto

	lemma fbrelationD1[dest]:
	assumes "fbrelation r" and "x \<in>\<^sub>\<circ> r"
	shows "\<exists>a b. x = [a, b]\<^sub>\<circ>"
	using assms by auto


	text\<open>Set operations.\<close>

	lemma fbrelation_vsubset:
	assumes "fbrelation s" and "r \<subseteq>\<^sub>\<circ> s"
	shows "fbrelation r"
	using assms by auto

	lemma fbrelation_vinsert: "fbrelation (vinsert [a, b]\<^sub>\<circ> r) \<longleftrightarrow> fbrelation r"
	by auto

	lemma (in fbrelation) fbrelation_vinsertI: "fbrelation (vinsert [a, b]\<^sub>\<circ> r)"
	using fbrelation_axioms by auto

	lemma fbrelation_vinsertD[dest]:
	assumes "fbrelation (vinsert \<langle>a, b\<rangle> r)"
	shows "fbrelation r"
	using assms by auto

	lemma fbrelation_vunion: "fbrelation (r \<union>\<^sub>\<circ> s) \<longleftrightarrow> fbrelation r \<and> fbrelation s"
	by auto

	lemma (in fbrelation_pair) fbrelation_vunionI: "fbrelation (r\<^sub>1 \<union>\<^sub>\<circ> r\<^sub>2)"
	using r\<^sub>1.fbrelation_axioms r\<^sub>2.fbrelation_axioms by auto

	lemma fbrelation_vunionD[dest]:
	assumes "fbrelation (r \<union>\<^sub>\<circ> s)"
	shows "fbrelation r" and "fbrelation s"
	using assms by auto

	lemma (in fbrelation) fbrelation_vintersectionI: "fbrelation (r \<inter>\<^sub>\<circ> s)"
	using fbrelation_axioms by auto

	lemma (in fbrelation) fbrelation_vdiffI: "fbrelation (r -\<^sub>\<circ> s)"
	using fbrelation_axioms by auto


	text\<open>Connections.\<close>

	lemma fbrelation_vempty: "fbrelation 0" by auto

	lemma fbrelation_vsingleton: "fbrelation (set {[a, b]\<^sub>\<circ>})" by auto

	global_interpretation frel_vsingleton: fbrelation \<open>set {[a, b]\<^sub>\<circ>}\<close>
	by (rule fbrelation_vsingleton)

	lemma fbrelation_vdoubleton: "fbrelation (set {[a, b]\<^sub>\<circ>, [c, d]\<^sub>\<circ>})" by auto

	lemma fbrelation_sid_on[simp]: "fbrelation (fid_on A)" by auto

	lemma fbrelation_fconst_on[simp]: "fbrelation (fconst_on A c)" by auto

	lemma (in fbrelation_pair) fbrelation_fcomp: "fbrelation (r\<^sub>1 \<circ>\<^sub>\<bullet> r\<^sub>2)"
	using r\<^sub>1.fbrelation_axioms r\<^sub>2.fbrelation_axioms by auto

	sublocale fbrelation_pair \<subseteq> fcomp\<^sub>2\<^sub>1: fbrelation \<open>r\<^sub>2 \<circ>\<^sub>\<bullet> r\<^sub>1\<close>
	by
	(
	simp add:
	fbrelation_pair.fbrelation_fcomp
	fbrelation_pair_def
	r\<^sub>1.fbrelation_axioms
	r\<^sub>2.fbrelation_axioms
	)

	sublocale fbrelation_pair \<subseteq> fcomp\<^sub>1\<^sub>2: fbrelation \<open>r\<^sub>1 \<circ>\<^sub>\<bullet> r\<^sub>2\<close>
	by (rule fbrelation_fcomp)

	lemma (in fbrelation) fbrelation_fconverse: "fbrelation (r\<inverse>\<^sub>\<bullet>)"
	using fbrelation_axioms by clarsimp

	lemma fbrelation_flrestriction[intro, simp]: "fbrelation (r \<restriction>\<^sup>l\<^sub>\<bullet> A)" by auto

	lemma fbrelation_frrestriction[intro, simp]: "fbrelation (r \<restriction>\<^sup>r\<^sub>\<bullet> A)" by auto

	lemma fbrelation_frestriction[intro, simp]: "fbrelation (r \<restriction>\<^sub>\<bullet> A)" by auto


	text\<open>Previous connections.\<close>

	lemma (in fbrelation) fconverse_fconverse[simp]: "(r\<inverse>\<^sub>\<bullet>)\<inverse>\<^sub>\<bullet> = r"
	using fbrelation_axioms by auto

	lemma (in fbrelation_pair) fconverse_mono[simp]: "r\<^sub>1\<inverse>\<^sub>\<bullet> \<subseteq>\<^sub>\<circ> r\<^sub>2\<inverse>\<^sub>\<bullet> \<longleftrightarrow> r\<^sub>1 \<subseteq>\<^sub>\<circ> r\<^sub>2"
	using r\<^sub>1.fbrelation_axioms r\<^sub>2.fbrelation_axioms
	by (force intro: fconverse_vunion)+

	lemma (in fbrelation_pair) fconverse_inject[simp]: "r\<^sub>1\<inverse>\<^sub>\<bullet> = r\<^sub>2\<inverse>\<^sub>\<bullet> \<longleftrightarrow> r\<^sub>1 = r\<^sub>2"
	using r\<^sub>1.fbrelation_axioms r\<^sub>2.fbrelation_axioms by fast

	lemma (in fbrelation) fconverse_vsubset_swap_2:
	assumes "r\<inverse>\<^sub>\<bullet> \<subseteq>\<^sub>\<circ> s"
	shows "r \<subseteq>\<^sub>\<circ> s\<inverse>\<^sub>\<bullet>"
	using assms fbrelation_axioms by auto

	lemma (in fbrelation) flrestriction_fdomain[simp]: "r \<restriction>\<^sup>l\<^sub>\<bullet> \<D>\<^sub>\<bullet> r = r"
	using fbrelation_axioms by (elim fbrelationE) blast

	lemma (in fbrelation) frrestriction_frange[simp]: "r \<restriction>\<^sup>r\<^sub>\<bullet> \<R>\<^sub>\<bullet> r = r"
	using fbrelation_axioms by (elim fbrelationE) blast


	text\<open>Special properties.\<close>

	lemma vsubset_vtimes_fbrelation:
	assumes "r \<subseteq>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	shows "fbrelation r"
	using assms by blast

	lemma (in fbrelation) fbrelation_vintersection_vdomain:
	assumes "vdisjnt (\<D>\<^sub>\<bullet> r) (\<D>\<^sub>\<bullet> s)"
	shows "vdisjnt r s"
	proof(rule vsubset_antisym; rule vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis fbrelationE1 fbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed simp

	lemma (in fbrelation) fbrelation_vintersection_vrange:
	assumes "vdisjnt (\<R>\<^sub>\<bullet> r) (\<R>\<^sub>\<bullet> s)"
	shows "vdisjnt r s"
	proof(rule vsubset_antisym; rule vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis fbrelationE1 fbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed simp

	lemma (in fbrelation) fbrelation_vintersection_vfield:
	assumes "vdisjnt (ffield r) (ffield s)"
	shows "vdisjnt r s"
	proof(rule vsubset_antisym; rule vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	then obtain a b where "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<inter>\<^sub>\<circ> s"
	by (metis fbrelationE1 fbrelation_vintersectionI)
	with assms show "x \<in>\<^sub>\<circ> 0" by auto
	qed auto

	lemma (in fbrelation) vdomain_vrange_vtimes: "r \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<bullet> r \<times>\<^sub>\<bullet> \<R>\<^sub>\<bullet> r"
	using fbrelation by blast

	lemma (in fbrelation) fconverse_eq_frel[intro, simp]:
	assumes "\<And>a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r \<Longrightarrow> [b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> r"
	shows "r\<inverse>\<^sub>\<bullet> = r"
	using assms
	apply (intro vsubset_antisym; intro vsubsetI)
	subgoal by blast
	subgoal by (metis fconverseE fconverseI fconverse_fconverse)
	done

	lemma fcomp_fconverse_frel_eq_frel_fbrelationI:
	assumes "r\<inverse>\<^sub>\<bullet> \<circ>\<^sub>\<bullet> r = r"
	shows "fbrelation r"
	using assms by (intro fbrelationI, elim vequalityE vsubsetE) force


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro, simp] = fbrelation.fconverse_fconverse
	and fconverse_eq_frel[intro, simp] = fbrelation.fconverse_eq_frel

	context
	fixes r\<^sub>1 r\<^sub>2
	assumes r\<^sub>1: "fbrelation r\<^sub>1"
	and r\<^sub>2: "fbrelation r\<^sub>2"
	begin

	lemmas_with[OF fbrelation_pair.intro[OF r\<^sub>1 r\<^sub>2]] :
	fbrelation_fconverse_mono[intro, simp] = fbrelation_pair.fconverse_mono
	and fbrelation_frrestriction_srange[intro, simp] =
	fbrelation_pair.fconverse_inject

	end

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_FSequences.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_FSequences.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_FSequences.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_FSequences.thy
	@@ -1,1380 +1,1466 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Finite sequences\<close>
	theory CZH_Sets_FSequences
	imports CZH_Sets_Cardinality
	begin



	subsection\<open>Background\<close>


	text\<open>
	The section presents a theory of finite sequences internalized in the
	type \<^typ>\<open>V\<close>. The content of this subsection
	was inspired by and draws on many ideas from the content
	of the theory \<open>List\<close> in the main library of Isabelle/HOL.
	\<close>



	subsection\<open>Definition and common properties\<close>


	text\<open>
	A finite sequence is defined as a single-valued binary relation whose domain
	is an initial segment of the set of natural numbers.
	\<close>

	locale vfsequence = vsv xs for xs +
	assumes vfsequence_vdomain_in_omega: "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"

	locale vfsequence_pair = r\<^sub>1: vfsequence xs\<^sub>1 + r\<^sub>2: vfsequence xs\<^sub>2 for xs\<^sub>1 xs\<^sub>2


	text\<open>Rules.\<close>

	lemmas [intro] = vfsequence.axioms(1)

	lemma vfsequenceI[intro]:
	assumes "vsv xs" and "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
	shows "vfsequence xs"
	using assms by (simp add: vfsequence.intro vfsequence_axioms_def)

	lemma vfsequenceD[dest]:
	assumes "vfsequence xs"
	shows "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
	using assms vfsequence.vfsequence_vdomain_in_omega by simp

	lemma vfsequenceE[elim]:
	assumes "vfsequence xs" and "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega> \<Longrightarrow> P"
	shows P
	using assms by auto

	lemma vfsequence_iff: "vfsequence xs \<longleftrightarrow> vsv xs \<and> \<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
	using vfsequence_def by auto


	text\<open>Elementary properties.\<close>

	lemma (in vfsequence) vfsequence_vdomain: "\<D>\<^sub>\<circ> xs = vcard xs"
	unfolding vsv_vcard_vdomain[symmetric] using vfsequence_vdomain_in_omega by simp

	lemma (in vfsequence) vfsequence_vcard_in_omega[simp]: "vcard xs \<in>\<^sub>\<circ> \<omega>"
	using vfsequence_vdomain_in_omega by (simp add: vfsequence_vdomain)


	text\<open>Set operations.\<close>

	lemma vfsequence_vempty[intro, simp]: "vfsequence 0" by (simp add: vfsequenceI)

	lemma vfsequence_vsingleton[intro, simp]: "vfsequence (set {\<langle>0, a\<rangle>})"
	using vone_in_omega
	unfolding one_V_def
	by (intro vfsequenceI) (auto simp: set_vzero_eq_ord_of_nat_vone)

	lemma (in vfsequence) vfsequence_vinsert:
	"vfsequence (vinsert \<langle>vcard xs, a\<rangle> xs)"
	using succ_def succ_in_omega by (auto simp: vfsequence_vdomain)


	text\<open>Connections.\<close>

	lemma (in vfsequence) vfsequence_vfinite[simp]: "vfinite xs"
	by (simp add: vfinite_vcard_omega_iff)

	lemma (in vfsequence) vfsequence_vlrestriction[intro, simp]:
	assumes "k \<in>\<^sub>\<circ> \<omega>"
	shows "vfsequence (xs \<restriction>\<^sup>l\<^sub>\<circ> k)"
	using assms by (force simp: vfsequence_vdomain vdomain_vlrestriction)

	lemma vfsequence_vproduct:
	assumes "n \<in>\<^sub>\<circ> \<omega>" and "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)"
	shows "vfsequence xs"
	using assms by auto

	lemma vfsequence_vcpower:
	assumes "n \<in>\<^sub>\<circ> \<omega>" and "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> n"
	shows "vfsequence xs"
	using assms vfsequence_vproduct by auto

	+lemma vfsequence_vcomp_vsv_vfsequence:
	+ assumes "vsv f" and "vfsequence xs" and "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	+ shows "vfsequence (f \<circ>\<^sub>\<circ> xs)"
	+proof(intro vfsequenceI vsv_vcomp)
	+ interpret xs: vfsequence xs by (rule assms(2))
	+ show "\<D>\<^sub>\<circ> (f \<circ>\<^sub>\<circ> xs) \<in>\<^sub>\<circ> \<omega>"
	+ unfolding vdomain_vcomp_vsubset[OF assms(3)]
	+ by (force simp: xs.vfsequence_vdomain_in_omega)
	+qed (auto intro: assms)
	+

	text\<open>Special properties.\<close>

	lemma (in vfsequence) vfsequence_vdomain_vlrestriction[intro, simp]:
	assumes "k \<in>\<^sub>\<circ> vcard xs"
	shows "\<D>\<^sub>\<circ> (xs \<restriction>\<^sup>l\<^sub>\<circ> k) = k"
	using assms
	by
	(
	simp add:
	OrdmemD
	inf_absorb2
	order.strict_implies_order
	vdomain_vlrestriction
	vfsequence_vdomain
	)

	lemma (in vfsequence) vfsequence_vlrestriction_vcard[simp]:
	"xs \<restriction>\<^sup>l\<^sub>\<circ> (vcard xs) = xs"
	by (rule vlrestriction_vdomain[unfolded vfsequence_vdomain])

	lemma vfsequence_vfinite_vcardI:
	assumes "vsv xs" and "vfinite xs" and "\<D>\<^sub>\<circ> xs = vcard xs"
	shows "vfsequence xs"
	using assms by (intro vfsequenceI) (auto simp: vfinite_vcard_omega)

	lemma (in vfsequence) vfsequence_vrangeE:
	assumes "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
	obtains n where "n \<in>\<^sub>\<circ> vcard xs" and "xs\<lparr>n\<rparr> = a"
	using assms vfsequence_vdomain by auto

	lemma (in vfsequence) vfsequence_vrange_vproduct:
	assumes "\<And>i. i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	shows "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
	using vfsequence_vdomain vsv_axioms assms
	by
	(
	intro vproductI;
	(intro vsv.vsv_vrange_vsubset_vifunion_app \| tactic\<open>all_tac\<close>)
	) auto

	lemma (in vfsequence) vfsequence_vrange_vcpower:
	assumes "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> A"
	shows "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> (vcard xs)"
	using assms
	proof(elim vsubsetE; intro vcpowerI)
	assume hyp: "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xs \<Longrightarrow> x \<in>\<^sub>\<circ> A" for x
	from vfsequence_vdomain show "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A)"
	by (intro vproductI) (blast intro: hyp elim: vdomain_atE)+
	qed


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro, simp] = vfsequence.vfsequence_vcard_in_omega
	and [intro, simp] = vfsequence.vfsequence_vfinite
	and [intro, simp] = vfsequence.vfsequence_vlrestriction
	and [intro, simp] = vfsequence.vfsequence_vdomain_vlrestriction
	and [intro, simp] = vfsequence.vfsequence_vlrestriction_vcard



	subsection\<open>Appending an element to a finite sequence: \<open>vcons\<close>\<close>


	subsubsection\<open>Definition and common properties\<close>

	definition vcons :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>#\<^sub>\<circ>\<close> 65)
	where "xs #\<^sub>\<circ> x = vinsert \<langle>vcard xs, x\<rangle> xs"


	text\<open>Syntax.\<close>

	abbreviation vempty_vfsequence (\<open>[]\<^sub>\<circ>\<close>) where
	"vempty_vfsequence \<equiv> 0::V"

	notation vempty_vfsequence (\<open>[]\<^sub>\<circ>\<close>)

	nonterminal fsfields
	nonterminal vlist

	syntax
	"" :: "V \<Rightarrow> fsfields" ("_")
	"_fsfields" :: "fsfields \<Rightarrow> V \<Rightarrow> fsfields" ("_,/ _")
	"_vlist" :: "fsfields \<Rightarrow> V" ("[(_)]\<^sub>\<circ>")
	"_vapp" :: "V \<Rightarrow> fsfields \<Rightarrow> V" ("_ \<lparr>(_)\<rparr>\<^sub>\<bullet>" [100, 100] 100)

	translations
	"[xs, x]\<^sub>\<circ>" == "[xs]\<^sub>\<circ> #\<^sub>\<circ> x"
	"[x]\<^sub>\<circ>" == "[]\<^sub>\<circ> #\<^sub>\<circ> x"

	translations
	"f\<lparr>xs, x\<rparr>\<^sub>\<bullet>" == "f\<lparr>[xs, x]\<^sub>\<circ>\<rparr>"
	"f\<lparr>x\<rparr>\<^sub>\<bullet>" == "f\<lparr>[x]\<^sub>\<circ>\<rparr>"


	text\<open>Rules.\<close>

	lemma vconsI[intro!]:
	assumes "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
	shows "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
	using assms unfolding vcons_def by clarsimp

	lemma vconsD[dest!]:
	assumes "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
	shows "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
	using assms unfolding vcons_def by clarsimp

	lemma vconsE[elim!]:
	assumes "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
	obtains a where "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
	using assms unfolding vcons_def by clarsimp


	text\<open>Elementary properties.\<close>

	lemma vcons_neq_vempty[simp]: "ys #\<^sub>\<circ> y \<noteq> []\<^sub>\<circ>" by auto


	text\<open>Set operations.\<close>

	lemma vcons_vsingleton: "[a]\<^sub>\<circ> = set {\<langle>0\<^sub>\<nat>, a\<rangle>}" unfolding vcons_def by simp

	lemma vcons_vdoubleton: "[a, b]\<^sub>\<circ> = set {\<langle>0\<^sub>\<nat>, a\<rangle>, \<langle>1\<^sub>\<nat>, b\<rangle>}"
	unfolding vcons_def
	using vinsert_vsingleton
	by (force simp: vinsert_set_insert_eq)

	lemma vcons_vsubset: "xs \<subseteq>\<^sub>\<circ> xs #\<^sub>\<circ> x" by clarsimp

	lemma vcons_vsubset':
	assumes "vcons xs x \<subseteq>\<^sub>\<circ> ys"
	shows "vcons xs x \<subseteq>\<^sub>\<circ> vcons ys y"
	using assms unfolding vcons_def by auto


	text\<open>Connections.\<close>

	lemma (in vfsequence) vfsequence_vcons[intro, simp]: "vfsequence (xs #\<^sub>\<circ> x)"
	proof(intro vfsequenceI)
	from vfsequence_vdomain_in_omega vsv_vcard_vdomain have "vcard xs = \<D>\<^sub>\<circ> xs"
	by (simp add: vcard_veqpoll)
	show "vsv (xs #\<^sub>\<circ> x)"
	proof(intro vsvI)
	fix a b c assume ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x" and ac: "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
	then consider (dom) "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" \| (ndom) "a = vcard xs"
	unfolding vcons_def by auto
	then show "b = c"
	proof cases
	case dom
	with ab have "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> xs"
	unfolding vcons_def by (auto simp: \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
	moreover from dom ac have "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> xs"
	unfolding vcons_def by (auto simp: \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
	ultimately show ?thesis using vsv by simp
	next
	case ndom
	from ab have "\<langle>a, b\<rangle> = \<langle>vcard xs, x\<rangle>"
	unfolding ndom vcons_def using \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close> mem_not_refl by blast
	moreover from ac have "\<langle>a, c\<rangle> = \<langle>vcard xs, x\<rangle>"
	unfolding ndom vcons_def using \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close> mem_not_refl by blast
	ultimately show ?thesis by simp
	qed
	next
	show "vbrelation (xs #\<^sub>\<circ> x)" unfolding vcons_def
	using vbrelation_vinsertI by auto
	qed
	show "\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<in>\<^sub>\<circ> \<omega>"
	unfolding vcons_def
	using succ_in_omega
	by (auto simp: vfsequence_vdomain_in_omega succ_def \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
	qed

	lemma (in vfsequence) vfsequence_vcons_vdomain[simp]:
	"\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = succ (vcard xs)"
	by (simp add: succ_def vcons_def vfsequence_vdomain)

	lemma (in vfsequence) vfsequence_vcons_vrange[simp]:
	"\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = vinsert x (\<R>\<^sub>\<circ> xs)"
	by (simp add: vcons_def)

	lemma (in vfsequence) vfsequence_vrange_vconsI:
	assumes "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> X" and "x \<in>\<^sub>\<circ> X"
	shows "\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<subseteq>\<^sub>\<circ> X"
	using assms unfolding vcons_def by auto

	lemmas vfsequence_vrange_vconsI = vfsequence.vfsequence_vrange_vconsI[rotated 1]


	text\<open>Special properties.\<close>

	lemma vcons_vrange_mono:
	assumes "xs \<subseteq>\<^sub>\<circ> ys"
	shows "\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (ys #\<^sub>\<circ> x)"
	using assms
	unfolding vcons_def
	by (simp add: vrange_mono vsubset_vinsert_leftI vsubset_vinsert_rightI)

	lemma (in vfsequence) vfsequence_vlrestriction_succ:
	assumes [simp]: "k \<in>\<^sub>\<circ> vcard xs"
	shows "xs \<restriction>\<^sup>l\<^sub>\<circ> succ k = xs \<restriction>\<^sup>l\<^sub>\<circ> k #\<^sub>\<circ> (xs\<lparr>k\<rparr>)"
	proof-
	interpret vlr: vfsequence \<open>xs \<restriction>\<^sup>l\<^sub>\<circ> k\<close>
	using assms by (blast intro: vfsequence_vcard_in_omega Ord_trans)
	from vlr.vfsequence_vdomain[symmetric, simplified] show ?thesis
	by
	(
	simp add:
	vcons_def succ_def vfsequence_vdomain vsv_vlrestriction_vinsert
	)
	qed

	lemma (in vfsequence) vfsequence_vremove_vcons_vfsequence:
	assumes "xs = xs' #\<^sub>\<circ> x"
	shows "vfsequence xs'"
	proof(cases\<open>\<langle>vcard xs', x\<rangle> \<in>\<^sub>\<circ> xs'\<close>)
	case True
	with assms[unfolded vcons_def] have "xs = xs'" by auto
	then show ?thesis using vfsequence_axioms by simp
	next
	case False
	note x_def[simp] = assms[unfolded vcons_def]
	interpret xs': vsv xs' using vsv_axioms by (auto intro: vsv_vinsertD)
	have fin: "vfinite xs'" using vfsequence_vfinite by auto
	have vcard_xs: "vcard xs = succ (vcard xs')" by (simp add: fin False)
	have [simp]: "vcard xs' \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> xs'" using False vsv_axioms by auto
	have "vcard xs' \<in>\<^sub>\<circ> \<omega>" using fin vfinite_vcard_omega by auto
	have xs'_def: "xs' = xs \<restriction>\<^sup>l\<^sub>\<circ> (vcard xs')"
	using vcard_xs fin vfsequence_vdomain
	by (auto simp: vinsert_ident succ_def)
	from vfsequence_vlrestriction[OF \<open>vcard xs' \<in>\<^sub>\<circ> \<omega>\<close>] show ?thesis
	unfolding xs'_def[symmetric] .
	qed

	lemma (in vfsequence) vfsequence_vcons_ex:
	assumes "xs \<noteq> []\<^sub>\<circ>"
	obtains xs' x where "xs = xs' #\<^sub>\<circ> x" and "vfsequence xs'"
	proof-
	from vcard_vempty have "0 \<in>\<^sub>\<circ> vcard xs" by (simp add: assms mem_0_Ord)
	then obtain k where succk: "succ k = vcard xs"
	by (metis omega_prev vfsequence_vcard_in_omega)
	then have "k \<in>\<^sub>\<circ> vcard xs" using elts_succ by blast
	from vfsequence_vlrestriction_succ[OF this, unfolded succk] show ?thesis
	by (simp add: vfsequence_vremove_vcons_vfsequence that)
	qed


	subsubsection\<open>Induction and case analysis\<close>

	lemma vfsequence_induct[consumes 1, case_names 0 vcons]:
	assumes "vfsequence xs"
	and "P []\<^sub>\<circ>"
	and "\<And>xs x. \<lbrakk>vfsequence xs; P xs\<rbrakk> \<Longrightarrow> P (xs #\<^sub>\<circ> x)"
	shows "P xs"
	proof-
	interpret vfsequence xs by (rule assms(1))
	from assms(1) obtain n where "n \<in>\<^sub>\<circ> \<omega>" and "\<D>\<^sub>\<circ> xs = n" by auto
	then have "n \<le> \<D>\<^sub>\<circ> xs" by auto
	define P' where "P' k = P (xs \<restriction>\<^sup>l\<^sub>\<circ> k)" for k
	from \<open>n \<in>\<^sub>\<circ> \<omega>\<close> and \<open>n \<le> \<D>\<^sub>\<circ> xs\<close> have "P' n"
	proof(induction rule: omega_induct)
	case (succ n') then show ?case
	proof-
	interpret vlr: vfsequence \<open>xs \<restriction>\<^sup>l\<^sub>\<circ> n'\<close> by (simp add: succ.hyps)
	have "P' n'" using succ.prems by (force intro: succ.IH)
	then have "P (xs \<restriction>\<^sup>l\<^sub>\<circ> n')" unfolding P'_def by assumption
	have "n' \<in>\<^sub>\<circ> vcard xs"
	using succ.prems by (auto simp: vsubset_iff vfsequence_vdomain)
	from vfsequence_vlrestriction_succ[OF \<open>n' \<in>\<^sub>\<circ> vcard xs\<close>]
	show "P' (succ n')"
	by (simp add: P'_def \<open>P (xs \<restriction>\<^sup>l\<^sub>\<circ> n')\<close> assms(3) vlr.vfsequence_axioms)
	qed
	qed (simp add: P'_def assms(2))
	then show ?thesis unfolding P'_def \<open>\<D>\<^sub>\<circ> xs = n\<close>[symmetric] by simp
	qed

	lemma vfsequence_cases[consumes 1, case_names 0 vcons]:
	assumes "vfsequence xs"
	and "xs = []\<^sub>\<circ> \<Longrightarrow> P"
	and "\<And>xs' x. \<lbrakk>xs = xs' #\<^sub>\<circ> x; vfsequence xs'\<rbrakk> \<Longrightarrow> P"
	shows P
	proof-
	interpret vfsequence xs by (rule assms(1))
	show ?thesis
	proof(cases \<open>xs = 0\<close>)
	case False
	then obtain xs' x where "xs = xs' #\<^sub>\<circ> x"
	by (blast intro: vfsequence_vcons_ex)
	then show ?thesis by (auto simp: assms(3) intro: vfsequence_vcons_ex)
	qed (use assms(2) in auto)
	qed


	subsubsection\<open>Evaluation\<close>

	lemma (in vfsequence) vfsequence_vcard_vcons[simp]:
	"vcard (xs #\<^sub>\<circ> x) = succ (vcard xs)"
	proof-
	interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close> by simp
	have "vcard (xs #\<^sub>\<circ> x) = \<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x)"
	by (rule xsx.vfsequence_vdomain[symmetric])
	then show ?thesis
	by (subst vcons_def) (simp add: succ_def vcons_def vfsequence_vdomain)
	qed

	lemma (in vfsequence) vfsequence_at_last[intro, simp]:
	assumes "i = vcard xs"
	shows "(xs #\<^sub>\<circ> x)\<lparr>i\<rparr> = x"
	by (simp add: vfsequence_vdomain vcons_def assms)

	lemma (in vfsequence) vfsequence_at_not_last[intro, simp]:
	assumes "i \<in>\<^sub>\<circ> vcard xs"
	shows "(xs #\<^sub>\<circ> x)\<lparr>i\<rparr> = xs\<lparr>i\<rparr>"
	proof-
	from assms have [simp]: "\<D>\<^sub>\<circ> xs = vcard xs" by (auto simp: vfsequence_vdomain)
	from assms have "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" by simp
	moreover have "i \<noteq> vcard xs" using assms mem_not_refl by blast
	ultimately show ?thesis
	unfolding vcons_def using vsv.vsv_vinsert vsvE vsv_axioms by auto
	qed


	text\<open>Alternative forms of existing results.\<close>

	lemmas [intro, simp] = vfsequence.vfsequence_vcons
	and [intro, simp] = vfsequence.vfsequence_vcard_vcons
	and [intro, simp] = vfsequence.vfsequence_at_last
	and [intro, simp] = vfsequence.vfsequence_at_not_last
	and [intro, simp] = vfsequence.vfsequence_vcons_vdomain
	and [intro, simp] = vfsequence.vfsequence_vcons_vrange



	subsubsection\<open>Congruence-like properties\<close>

	context vfsequence_pair
	begin

	lemma vcons_eq_vcard_eq:
	assumes "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
	shows "vcard xs\<^sub>1 = vcard xs\<^sub>2"
	by
	(
	metis
	assms
	succ_inject_iff
	vfsequence.vfsequence_vcons_vdomain
	r\<^sub>1.vfsequence_axioms
	r\<^sub>2.vfsequence_axioms
	)

	lemma vcons_eqD[dest]:
	assumes "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
	shows "xs\<^sub>1 = xs\<^sub>2" and "x\<^sub>1 = x\<^sub>2"
	proof-

	have xsx1_last: "(xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1)\<lparr>vcard xs\<^sub>1\<rparr> = x\<^sub>1" by simp
	have xsx2_last: "(xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2)\<lparr>vcard xs\<^sub>2\<rparr> = x\<^sub>2" by simp

	from assms have vcard: "vcard xs\<^sub>1 = vcard xs\<^sub>2" by (rule vcons_eq_vcard_eq)
	from trans[OF xsx1_last xsx1_last[unfolded vcard assms, symmetric]]

	show "x\<^sub>1 = x\<^sub>2" unfolding xsx1_last xsx2_last .

	have nxs1: "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>1"
	using mem_not_refl r\<^sub>1.vfsequence_vdomain by blast
	have nxs2: "\<langle>vcard xs\<^sub>2, x\<^sub>2\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>2"
	using mem_not_refl r\<^sub>2.vfsequence_vdomain by blast
	have xsx1_xsx2: "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> = \<langle>vcard xs\<^sub>2, x\<^sub>2\<rangle>"
	unfolding vcons_eq_vcard_eq[OF assms(1)] \<open>x\<^sub>1 = x\<^sub>2\<close> by simp

	show "xs\<^sub>1 = xs\<^sub>2"
	proof(rule vinsert_identD[OF _ nxs1])
	from assms(1)[unfolded vcons_def] show
	"vinsert \<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> xs\<^sub>1 = vinsert \<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> xs\<^sub>2"
	by (auto simp: xsx1_xsx2)
	show "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>2"
	by (rule nxs2[folded \<open>x\<^sub>1 = x\<^sub>2\<close> vcons_eq_vcard_eq[OF assms(1)]])
	qed

	qed

	lemma vcons_eqI:
	assumes "xs\<^sub>1 = xs\<^sub>2" and "x\<^sub>1 = x\<^sub>2"
	shows "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
	using assms by (rule arg_cong2)

	lemma vcons_eq_iff[simp]: "(xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2) \<longleftrightarrow> (xs\<^sub>1 = xs\<^sub>2 \<and> x\<^sub>1 = x\<^sub>2)"
	by auto

	end


	text\<open>Alternative forms of existing results.\<close>

	context
	fixes xs\<^sub>1 xs\<^sub>2
	assumes xs\<^sub>1: "vfsequence xs\<^sub>1"
	and xs\<^sub>2: "vfsequence xs\<^sub>2"
	begin

	lemmas_with[OF vfsequence_pair.intro[OF xs\<^sub>1 xs\<^sub>2]]:
	vcons_eqD' = vfsequence_pair.vcons_eqD
	and vcons_eq_iff[intro, simp] = vfsequence_pair.vcons_eq_iff

	end

	lemmas vcons_eqD[dest] = vcons_eqD'[rotated -1]



	subsection\<open>Transfer between the type \<^typ>\<open>V list\<close> and finite sequences\<close>


	subsubsection\<open>Initialization\<close>

	primrec vfsequence_of_vlist :: "V list \<Rightarrow> V"
	where
	"vfsequence_of_vlist [] = 0"
	\| "vfsequence_of_vlist (x # xs) = vfsequence_of_vlist xs #\<^sub>\<circ> x"

	definition vlist_of_vfsequence :: "V \<Rightarrow> V list"
	where "vlist_of_vfsequence = inv_into UNIV vfsequence_of_vlist"

	lemma vfsequence_vfsequence_of_vlist: "vfsequence (vfsequence_of_vlist xs)"
	by (induction xs) auto

	lemma inj_vfsequence_of_vlist: "inj vfsequence_of_vlist"
	proof
	show "vfsequence_of_vlist x = vfsequence_of_vlist y \<Longrightarrow> x = y"
	for x y
	proof(induction y arbitrary: x)
	case Nil then show ?case by (cases x) auto
	next
	case (Cons a ys)
	note Cons' = Cons
	show ?case
	proof(cases x)
	case Nil with Cons show ?thesis by auto
	next
	case (Cons b zs)
	from Cons'[unfolded Cons vfsequence_of_vlist.simps] have
	"vfsequence_of_vlist zs #\<^sub>\<circ> b = vfsequence_of_vlist ys #\<^sub>\<circ> a"
	by simp
	then have "vfsequence_of_vlist zs = vfsequence_of_vlist ys" and "b = a"
	by (auto simp: vfsequence_vfsequence_of_vlist)
	from Cons'(1)[OF this(1)] this(2) show ?thesis unfolding Cons by auto
	qed
	qed
	qed

	lemma range_vfsequence_of_vlist:
	"range vfsequence_of_vlist = {xs. vfsequence xs}"
	proof(intro subset_antisym subsetI; unfold mem_Collect_eq)
	show "xs \<in> range vfsequence_of_vlist \<Longrightarrow> vfsequence xs" for xs
	by (clarsimp simp: vfsequence_vfsequence_of_vlist)
	fix xs assume "vfsequence xs"
	then show "xs \<in> range vfsequence_of_vlist"
	proof(induction rule: vfsequence_induct)
	case 0 then show ?case
	by (metis image_iff iso_tuple_UNIV_I vfsequence_of_vlist.simps(1))
	next
	case (vcons xs x) then show ?case
	by (metis rangeE rangeI vfsequence_of_vlist.simps(2))
	qed
	qed

	lemma vlist_of_vfsequence_vfsequence_of_vlist[simp]:
	"vlist_of_vfsequence (vfsequence_of_vlist xs) = xs"
	by (simp add: inj_vfsequence_of_vlist vlist_of_vfsequence_def)

	lemma (in vfsequence) vfsequence_of_vlist_vlist_of_vfsequence[simp]:
	"vfsequence_of_vlist (vlist_of_vfsequence xs) = xs"
	using vfsequence_axioms range_vfsequence_of_vlist inj_vfsequence_of_vlist
	by (simp add: f_inv_into_f vlist_of_vfsequence_def)

	lemmas vfsequence_of_vlist_vlist_of_vfsequence[intro, simp] =
	vfsequence.vfsequence_of_vlist_vlist_of_vfsequence

	lemma vlist_of_vfsequence_vempty[simp]: "vlist_of_vfsequence []\<^sub>\<circ> = []"
	by
	(
	metis
	vfsequence_of_vlist.simps(1)
	vlist_of_vfsequence_vfsequence_of_vlist
	)


	text\<open>Transfer relation 1.\<close>

	definition cr_vfsequence :: "V \<Rightarrow> V list \<Rightarrow> bool"
	where "cr_vfsequence a b \<longleftrightarrow> (a = vfsequence_of_vlist b)"

	lemma cr_vfsequence_right_total[transfer_rule]: "right_total cr_vfsequence"
	unfolding cr_vfsequence_def right_total_def by simp

	lemma cr_vfsequence_bi_unqie[transfer_rule]: "bi_unique cr_vfsequence"
	unfolding cr_vfsequence_def bi_unique_def
	by (simp add: inj_eq inj_vfsequence_of_vlist)

	lemma cr_vfsequence_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_vfsequence = (\<lambda>xs. vfsequence xs)"
	unfolding cr_vfsequence_def
	proof(intro HOL.ext, rule iffI)
	fix xs assume prems: "vfsequence xs"
	interpret vfsequence xs by (rule prems)
	have "\<exists>ys. xs = vfsequence_of_vlist ys"
	using prems
	proof(induction rule: vfsequence_induct)
	show "\<lbrakk> vfsequence xs; \<exists>ys. xs = vfsequence_of_vlist ys \<rbrakk> \<Longrightarrow>
	\<exists>ys. xs #\<^sub>\<circ> x = vfsequence_of_vlist ys"
	for xs x
	unfolding vfsequence_of_vlist_def by (metis list.simps(7))
	qed auto
	then show "Domainp (\<lambda>a b. a = vfsequence_of_vlist b) xs" by auto
	qed (clarsimp simp: vfsequence_vfsequence_of_vlist)

	lemma cr_vfsequence_vconsD:
	assumes "cr_vfsequence (xs #\<^sub>\<circ> x) (y # ys)"
	shows "cr_vfsequence xs ys" and "x = y"
	proof-
	from assms[unfolded cr_vfsequence_def] have xs_x_def:
	"xs #\<^sub>\<circ> x = vfsequence_of_vlist (y # ys)" .
	then have xs_x: "vfsequence (xs #\<^sub>\<circ> x)"
	by (simp add: vfsequence_vfsequence_of_vlist)
	interpret vfsequence xs
	by (blast intro: vfsequence.vfsequence_vremove_vcons_vfsequence xs_x)
	from
	assms[unfolded cr_vfsequence_def vfsequence_of_vlist.simps(2)]
	vfsequence_axioms
	show "cr_vfsequence xs ys" and "x = y"
	unfolding cr_vfsequence_def by (auto simp: vfsequence_vfsequence_of_vlist)
	qed


	text\<open>Transfer relation 2.\<close>

	definition cr_cr_vfsequence :: "V \<Rightarrow> V list list \<Rightarrow> bool"
	where "cr_cr_vfsequence a b \<longleftrightarrow>
	(a = vfsequence_of_vlist (map vfsequence_of_vlist b))"

	lemma cr_cr_vfsequence_right_total[transfer_rule]:
	"right_total cr_cr_vfsequence"
	unfolding cr_cr_vfsequence_def right_total_def by simp

	lemma cr_cr_vfsequence_bi_unqie[transfer_rule]: "bi_unique cr_cr_vfsequence"
	unfolding cr_cr_vfsequence_def bi_unique_def
	by (simp add: inj_eq inj_vfsequence_of_vlist)


	text\<open>Transfer relation for scalars.\<close>

	definition cr_scalar :: "(V \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> V \<Rightarrow> 'a \<Rightarrow> bool"
	where "cr_scalar R x y = (\<exists>a. x = [a]\<^sub>\<circ> \<and> R a y)"

	lemma cr_scalar_bi_unique[transfer_rule]:
	assumes "bi_unique R"
	shows "bi_unique (cr_scalar R)"
	using assms unfolding cr_scalar_def bi_unique_def by auto

	lemma cr_scalar_right_total[transfer_rule]:
	assumes "right_total R"
	shows "right_total (cr_scalar R)"
	using assms unfolding cr_scalar_def right_total_def by simp

	lemma cr_scalar_transfer_domain_rule[transfer_domain_rule]:
	"Domainp (cr_scalar R) = (\<lambda>x. \<exists>a. x = [a]\<^sub>\<circ> \<and> Domainp R a)"
	unfolding cr_scalar_def by auto


	subsubsection\<open>Transfer rules for previously defined entities\<close>

	context
	includes lifting_syntax
	begin

	lemma vfsequence_vempty_transfer[transfer_rule]: "cr_vfsequence []\<^sub>\<circ> []"
	unfolding cr_vfsequence_def by simp

	lemma vfsequence_vempty_ll_transfer[transfer_rule]:
	"cr_cr_vfsequence [[]\<^sub>\<circ>]\<^sub>\<circ> [[]]"
	unfolding cr_cr_vfsequence_def by simp

	lemma vcons_transfer[transfer_rule]:
	"((=) ===> cr_vfsequence ===> cr_vfsequence) (\<lambda>x xs. xs #\<^sub>\<circ> x) (\<lambda>x xs. x # xs)"
	by (intro rel_funI) (simp add: cr_vfsequence_def)

	lemma vcons_ll_transfer[transfer_rule]:
	"(cr_vfsequence ===> cr_cr_vfsequence ===> cr_cr_vfsequence)
	(\<lambda>x xs. xs #\<^sub>\<circ> x) (\<lambda>x xs. x # xs)"
	by (intro rel_funI) (simp add: cr_vfsequence_def cr_cr_vfsequence_def)

	lemma vfsequence_vrange_transfer[transfer_rule]:
	"(cr_vfsequence ===> (=)) (\<lambda>xs. elts (\<R>\<^sub>\<circ> xs)) list.set"
	proof(intro rel_funI)
	fix xs ys assume prems: "cr_vfsequence xs ys"
	then have "xs = vfsequence_of_vlist ys" unfolding cr_vfsequence_def by simp
	then have "vfsequence xs" by (simp add: vfsequence_vfsequence_of_vlist)
	from this prems show "elts (\<R>\<^sub>\<circ> xs) = list.set ys"
	proof(induction ys arbitrary: xs)
	case (Cons a ys)
	from Cons(2) show ?case
	proof(cases xs rule: vfsequence_cases)
	case 0 with Cons show ?thesis by (simp add: Cons.IH cr_vfsequence_def)
	next
	case (vcons xs' x)
	interpret vfsequence xs' by (rule vcons(2))
	note vcons_transfer = cr_vfsequence_vconsD[OF Cons(3)[unfolded vcons(1)]]
	have a_ys: "list.set (a # ys) = insert a (list.set ys)" by simp
	from vcons(2) have R_xs'x: "\<R>\<^sub>\<circ> (xs' #\<^sub>\<circ> x) = vinsert x (\<R>\<^sub>\<circ> xs')" by simp
	show "elts (\<R>\<^sub>\<circ> xs) = (list.set (a # ys))"
	unfolding vcons(1) R_xs'x a_ys
	by
	(
	auto simp:
	vcons_transfer(2) Cons(1)[OF vfsequence_axioms vcons_transfer(1)]
	)
	qed
	qed (auto simp: cr_vfsequence_def)
	qed

	lemma vcard_transfer[transfer_rule]:
	"(cr_vfsequence ===> cr_omega) vcard length"
	proof(intro rel_funI)
	fix xs ys assume prems: "cr_vfsequence xs ys"
	then have "xs = vfsequence_of_vlist ys" unfolding cr_vfsequence_def by simp
	then have "vfsequence xs" by (simp add: vfsequence_vfsequence_of_vlist)
	from this prems show "cr_omega (vcard xs) (length ys)"
	proof(induction ys arbitrary: xs)
	case (Cons y ys)
	from Cons(2) show ?case
	proof(cases xs rule: vfsequence_cases)
	case 0 with Cons show ?thesis by (simp add: Cons.IH cr_vfsequence_def)
	next
	case (vcons xs' x)
	interpret vfsequence xs' by (rule vcons(2))
	note vcons_transfer = cr_vfsequence_vconsD[OF Cons(3)[unfolded vcons(1)]]
	have vcard_xs_x: "vcard (xs' #\<^sub>\<circ> x) = succ (vcard xs')" by simp
	have vcard_y_ys: "length (y # ys) = Suc (length ys)" by simp
	from vfsequence_axioms have [transfer_rule]:
	"cr_omega (vcard xs') (length ys)"
	by (simp add: vcons_transfer(1) Cons.IH)
	show ?thesis unfolding vcons(1) vcard_xs_x vcard_y_ys by transfer_prover
	qed
	qed (auto simp: cr_omega_def cr_vfsequence_def)
	qed

	lemma vcard_ll_transfer[transfer_rule]:
	"(cr_cr_vfsequence ===> cr_omega) vcard length"
	unfolding cr_cr_vfsequence_def
	by (intro rel_funI)
	(metis cr_vfsequence_def length_map rel_funD vcard_transfer)

	end


	text\<open>Corollaries.\<close>

	+lemma vdomain_vfsequence_of_vlist: "\<D>\<^sub>\<circ> (vfsequence_of_vlist xs) = length xs"
	+proof-
	+ define ys where "ys = vfsequence_of_vlist xs"
	+ interpret vfsequence ys
	+ unfolding ys_def by (rule vfsequence_vfsequence_of_vlist)
	+ have [transfer_rule]: "cr_vfsequence ys xs"
	+ unfolding ys_def cr_vfsequence_def by simp_all
	+ show ?thesis
	+ by (fold ys_def, unfold vfsequence_vdomain, transfer) simp
	+qed
	+
	lemma vrange_vfsequence_of_vlist:
	"\<R>\<^sub>\<circ> (vfsequence_of_vlist xs) = set (list.set xs)"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfsequence_of_vlist xs)"
	define ys where "ys = vfsequence_of_vlist xs"
	have [transfer_rule]: "cr_vfsequence ys xs" "x = x"
	unfolding ys_def cr_vfsequence_def by simp_all
	show "x \<in>\<^sub>\<circ> set (list.set xs)" by transfer (simp add: prems[folded ys_def])
	next
	fix x assume prems: "x \<in>\<^sub>\<circ> set (list.set xs)"
	define ys where "ys = vfsequence_of_vlist xs"
	have [transfer_rule]: "cr_vfsequence ys xs" "x = x"
	unfolding ys_def cr_vfsequence_def by simp_all
	from prems[untransferred] show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfsequence_of_vlist xs)"
	unfolding ys_def by simp
	qed

	lemma cr_cr_vfsequence_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_cr_vfsequence =
	(\<lambda>xss. vfsequence xss \<and> (\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs))"
	proof(intro HOL.ext, rule iffI; (elim conjE \| intro conjI ballI))
	fix xss assume prems: "Domainp cr_cr_vfsequence xss"
	with vfsequence_vfsequence_of_vlist show xss: "vfsequence xss"
	unfolding cr_cr_vfsequence_def by clarsimp
	interpret vfsequence xss by (rule xss)
	fix xs assume prems': "xs \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xss"
	from prems obtain yss where xss_def:
	"xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
	unfolding cr_cr_vfsequence_def by clarsimp
	from prems' have "xs \<in>\<^sub>\<circ> set (list.set (map vfsequence_of_vlist yss))"
	unfolding xss_def vrange_vfsequence_of_vlist by simp
	then obtain ys where xs_def: "xs = vfsequence_of_vlist ys" by clarsimp
	show "vfsequence xs"
	unfolding xs_def by (simp add: vfsequence_vfsequence_of_vlist)
	next
	fix xss assume prems: "vfsequence xss" "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
	have "\<exists>yss. xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
	using prems
	proof(induction rule: vfsequence_induct)
	case (vcons xss x)
	let ?y = \<open>vlist_of_vfsequence x\<close>
	from vcons(2,3) obtain yss where xss_def:
	"xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
	by auto
	from vcons(3) have "vfsequence x" by auto
	then have x_def: "x = vfsequence_of_vlist (vlist_of_vfsequence x)" by simp
	then have
	"xss #\<^sub>\<circ> x = vfsequence_of_vlist (map vfsequence_of_vlist (?y # yss))"
	unfolding xss_def by simp
	then show ?case by blast
	qed (auto intro: exI[of _ \<open>[]\<close>])
	then show "Domainp cr_cr_vfsequence xss"
	unfolding cr_cr_vfsequence_def by blast
	qed


	subsubsection\<open>Appending elements\<close>

	definition vappend :: "V \<Rightarrow> V \<Rightarrow> V" (infixr "@\<^sub>\<circ>" 65)
	where "xs @\<^sub>\<circ> ys =
	vfsequence_of_vlist (vlist_of_vfsequence ys @ vlist_of_vfsequence xs)"


	text\<open>Transfer.\<close>

	lemma vappend_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vfsequence ===> cr_vfsequence ===> cr_vfsequence)
	(\<lambda>xs ys. vappend ys xs) append"
	by (intro rel_funI, unfold cr_vfsequence_def) (simp add: vappend_def)

	lemma vappend_ll_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_cr_vfsequence ===> cr_cr_vfsequence ===> cr_cr_vfsequence)
	(\<lambda>xs ys. vappend ys xs) append"
	by (intro rel_funI, unfold cr_cr_vfsequence_def) (simp add: vappend_def)


	text\<open>Elementary properties.\<close>

	lemma (in vfsequence) vfsequence_vappend_vempty_vfsequence[simp]:
	"[]\<^sub>\<circ> @\<^sub>\<circ> xs = xs"
	unfolding vappend_def by auto

	lemmas vfsequence_vappend_vempty_vfsequence[simp] =
	vfsequence.vfsequence_vappend_vempty_vfsequence

	lemma (in vfsequence) vfsequence_vappend_vfsequence_vempty[simp]:
	"xs @\<^sub>\<circ> []\<^sub>\<circ> = xs"
	unfolding vappend_def by auto

	lemmas vfsequence_vappend_vfsequence_vempty[simp] =
	vfsequence.vfsequence_vappend_vfsequence_vempty

	lemma vappend_vcons[simp]:
	assumes "vfsequence xs" and "vfsequence ys"
	shows "xs @\<^sub>\<circ> (ys #\<^sub>\<circ> y) = (xs @\<^sub>\<circ> ys) #\<^sub>\<circ> y"
	using append_Cons[where 'a=V, untransferred, OF assms(2,1)] by simp


	subsubsection\<open>Distinct elements\<close>

	definition vdistinct :: "V \<Rightarrow> bool"
	where "vdistinct xs = distinct (vlist_of_vfsequence xs)"


	text\<open>Transfer.\<close>

	lemma vdistinct_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vfsequence ===> (=)) vdistinct distinct"
	by (intro rel_funI, unfold cr_vfsequence_def) (simp add: vdistinct_def)

	lemma vdistinct_ll_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_cr_vfsequence ===> (=)) vdistinct distinct"
	by (intro rel_funI, unfold cr_cr_vfsequence_def)
	(
	metis
	vdistinct_def
	distinct_map
	inj_onI
	vlist_of_vfsequence_vfsequence_of_vlist
	)


	text\<open>Elementary properties.\<close>

	lemma (in vfsequence) vfsequence_vdistinct_if_vcard_vrange_eq_vcard:
	assumes "vcard (\<R>\<^sub>\<circ> xs) = vcard xs"
	shows "vdistinct xs"
	proof-
	have "finite (elts (\<R>\<^sub>\<circ> xs))" by (simp add: assms vcard_vfinite_omega)
	from vcard_finite_set[OF this] assms have "card (elts (\<R>\<^sub>\<circ> xs))\<^sub>\<nat> = vcard xs"
	by simp
	from card_distinct[where ?'a=V, untransferred, OF vfsequence_axioms this]
	show ?thesis.
	qed

	lemma vdistinct_vempty[intro, simp]: "vdistinct []\<^sub>\<circ>"
	proof-
	have t: "distinct ([]::V list)" by simp
	show ?thesis by (rule t[untransferred])
	qed

	lemma (in vfsequence) vfsequence_vcons_vdistinct:
	assumes "vdistinct (xs #\<^sub>\<circ> x)"
	shows "vdistinct xs"
	proof-
	from distinct.simps(2)[where 'a=V, THEN iffD1, THEN conjunct2, untransferred]
	show ?thesis
	using vfsequence_axioms assms by simp
	qed

	lemma (in vfsequence) vfsequence_vcons_nin_vrange:
	assumes "vdistinct (xs #\<^sub>\<circ> x)"
	shows "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
	proof-
	from distinct.simps(2)[where 'a=V, THEN iffD1, THEN conjunct1, untransferred]
	show ?thesis
	using vfsequence_axioms assms by simp
	qed

	lemma (in vfsequence) vfsequence_v11I[intro]:
	assumes "vdistinct xs"
	shows "v11 xs"
	using vfsequence_axioms assms
	proof(induction xs rule: vfsequence_induct)
	case (vcons xs x)
	interpret vfsequence xs by (rule vcons(1))
	from vcons(3) have dxs: "vdistinct xs" by (rule vfsequence_vcons_vdistinct)
	interpret v11 xs using dxs by (rule vcons(2))
	from vfsequence_vcons_nin_vrange[OF vcons(3)] have "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs" .
	show "v11 (xs #\<^sub>\<circ> x)"
	by
	(
	simp_all add:
	vcons_def vfsequence_vdomain vfsequence_vcons_nin_vrange[OF vcons(3)]
	)
	qed simp

	lemma (in vfsequence) vfsequence_vcons_vdistinctI:
	assumes "vdistinct xs" and "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
	shows "vdistinct (xs #\<^sub>\<circ> x)"
	proof-
	have t: "distinct xs \<Longrightarrow> x \<notin> list.set xs \<Longrightarrow> distinct (x # xs)"
	for x ::V and xs
	by simp
	from vfsequence_axioms assms show ?thesis by (rule t[untransferred])
	qed

	lemmas vfsequence_vcons_vdistinctI[intro] =
	vfsequence.vfsequence_vcons_vdistinctI

	lemma (in vfsequence) vfsequence_nin_vrange_vcons:
	assumes "y \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs" and "y \<noteq> x"
	shows "y \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x)"
	proof-
	have t: "y \<notin> list.set xs \<Longrightarrow> y \<noteq> x \<Longrightarrow> y \<notin> list.set (x # xs)"
	for x y :: V and xs
	by simp
	from vfsequence_axioms assms show ?thesis by (rule t[untransferred])
	qed

	lemmas vfsequence_nin_vrange_vcons[intro] =
	vfsequence.vfsequence_nin_vrange_vcons


	subsubsection\<open>Concatenation of sequences\<close>

	definition vconcat :: "V \<Rightarrow> V"
	where "vconcat xss =
	vfsequence_of_vlist(
	concat (map vlist_of_vfsequence (vlist_of_vfsequence xss))
	)"


	text\<open>Transfer.\<close>

	lemma vconcat_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_cr_vfsequence ===> cr_vfsequence) vconcat concat"
	proof(intro rel_funI)
	fix xs ys assume "cr_cr_vfsequence xs ys"
	then have xs_def: "xs = vfsequence_of_vlist (map vfsequence_of_vlist ys)"
	unfolding cr_cr_vfsequence_def by simp
	have main_eq: "map vlist_of_vfsequence (vlist_of_vfsequence xs) = ys"
	unfolding xs_def by (simp add: map_idI)
	show "cr_vfsequence (vconcat xs) (concat ys)"
	unfolding cr_vfsequence_def vconcat_def main_eq ..
	qed


	text\<open>Elementary properties.\<close>

	lemma vconcat_vempty[simp]: "vconcat []\<^sub>\<circ> = []\<^sub>\<circ>"
	unfolding vconcat_def by simp

	lemma vconcat_append[simp]:
	assumes "vfsequence xss"
	and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
	and "vfsequence yss"
	and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> yss. vfsequence xs"
	shows "vconcat (xss @\<^sub>\<circ> yss) = vconcat xss @\<^sub>\<circ> vconcat yss"
	using assms concat_append[where 'a=V, untransferred] by simp

	lemma vconcat_vcons[simp]:
	assumes "vfsequence xs" and "vfsequence xss" and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
	shows "vconcat (xss #\<^sub>\<circ> xs) = vconcat xss @\<^sub>\<circ> xs"
	using assms concat.simps(2)[where 'a=V, untransferred] by simp

	lemma (in vfsequence) vfsequence_vconcat_fsingleton[simp]: "vconcat [xs]\<^sub>\<circ> = xs"
	using vfsequence_axioms
	by
	(
	metis
	vfsequence_vappend_vempty_vfsequence
	vconcat_vcons
	vconcat_vempty
	vempty_nin
	vfsequence_vempty
	vrange_vempty
	)

	lemmas vfsequence_vconcat_fsingleton[simp] =
	vfsequence.vfsequence_vconcat_fsingleton



	subsection\<open>Finite sequences and the Cartesian product\<close>

	lemma vfsequence_vcons_vproductI[intro!]:
	assumes "n \<in>\<^sub>\<circ> \<omega>"
	and "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
	and "x \<in>\<^sub>\<circ> A (vcard xs)"
	and "n = vcard (xs #\<^sub>\<circ> x)"
	shows "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)"
	proof
	interpret xs: vfsequence xs
	using assms
	apply(intro vfsequenceI)
	subgoal by auto
	subgoal
	by
	(
	metis
	vcard_vfinite_omega
	vcons_vsubset
	vfinite_vcard_omega
	vfinite_vsubset vproductD(2)
	)
	done
	interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close> by auto
	show "vsv (xs #\<^sub>\<circ> x)" by (simp add: xsx.vsv_axioms)
	show D: "\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = n" unfolding assms(4) xsx.vfsequence_vdomain by auto
	from vproductD[OF assms(2)] have elem: "i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" for i
	by auto
	show "\<forall>i\<in>\<^sub>\<circ>n. (xs #\<^sub>\<circ> x)\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" by (auto simp: elem assms(3,4))
	qed

	lemma vfsequence_vcons_vproductD[dest]:
	assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)" and "n \<in>\<^sub>\<circ> \<omega>"
	shows "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
	and "x \<in>\<^sub>\<circ> A (vcard xs)"
	and "n = vcard (xs #\<^sub>\<circ> x)"
	proof-

	interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close>
	by (meson assms succ_in_omega vfsequence_vproduct)
	interpret xs: vfsequence xs
	by (blast intro: xsx.vfsequence_vremove_vcons_vfsequence)

	show n_def: "n = vcard (xs #\<^sub>\<circ> x)"
	using assms using xsx.vfsequence_vdomain by blast
	from vproductD[OF assms(1), unfolded n_def]
	have elem_xs_x: "i \<in>\<^sub>\<circ> vcard (xs #\<^sub>\<circ> x) \<Longrightarrow> (xs #\<^sub>\<circ> x)\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	for i
	by auto
	then have elem_xs[simp]: "i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" for i
	by (metis rev_vsubsetD vcard_mono vcons_vsubset xs.vfsequence_at_not_last)
	show "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
	by (auto simp: xs.vsv_axioms xs.vfsequence_vdomain)
	from elem_xs_x show "x \<in>\<^sub>\<circ> A (vcard xs)" by fastforce

	qed

	lemma vfsequence_vcons_vproductE[elim!]:
	assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)" and "n \<in>\<^sub>\<circ> \<omega>"
	obtains "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
	and "x \<in>\<^sub>\<circ> A (vcard xs)"
	and "n = vcard (xs #\<^sub>\<circ> x)"
	using assms by (auto simp: vfsequence_vcons_vproductD)



	subsection\<open>Binary Cartesian product based on finite sequences: \<open>ftimes\<close>\<close>

	definition ftimes :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<times>\<^sub>\<bullet>\<close> 80)
	where "ftimes a b \<equiv> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. if i = 0 then a else b)"

	lemma small_fpairs[simp]: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) clarsimp


	text\<open>Rules.\<close>

	lemma ftimesI1[intro]:
	assumes "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	unfolding ftimes_def
	proof
	show vsv: "vsv x" by (simp add: assms(1) vfsequence.axioms(1))
	then interpret vsv x .
	from assms show D: "\<D>\<^sub>\<circ> x = 2\<^sub>\<nat>"
	unfolding nat_omega_simps two One_nat_def by auto
	from assms(2,3) have i: "i \<in>\<^sub>\<circ> 2\<^sub>\<nat> \<Longrightarrow> x\<lparr>i\<rparr> \<in>\<^sub>\<circ> (if i = 0\<^sub>\<nat> then A else B)"
	for i
	unfolding assms(1) two nat_omega_simps One_nat_def by auto
	from i show "\<forall>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> (if i = 0 then A else B)" by auto
	qed

	lemma ftimesI2[intro!]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
	shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	using assms ftimesI1 by auto

	lemma fproductE1[elim!]:
	assumes "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
	obtains a b where "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
	proof-
	from vproduct_vdoubletonD[OF assms[unfolded two ftimes_def]]
	have x_def: "x = set {\<langle>0\<^sub>\<nat>, x\<lparr>0\<^sub>\<nat>\<rparr>\<rangle>, \<langle>1\<^sub>\<nat>, x\<lparr>1\<^sub>\<nat>\<rparr>\<rangle>}"
	and "x\<lparr>0\<^sub>\<nat>\<rparr> \<in>\<^sub>\<circ> A"
	and "x\<lparr>1\<^sub>\<nat>\<rparr> \<in>\<^sub>\<circ> B"
	by auto
	then show ?thesis using that using vcons_vdoubleton by simp
	qed

	lemma fproductE2[elim!]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B" obtains "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
	using assms by blast


	text\<open>Set operations.\<close>

	lemma vfinite_0_left[simp]: "0 \<times>\<^sub>\<bullet> b = 0"
	by (meson eq0_iff fproductE1)

	lemma vfinite_0_right[simp]: "a \<times>\<^sub>\<bullet> 0 = 0"
	by (meson eq0_iff fproductE1)

	lemma fproduct_vintersection: "(a \<inter>\<^sub>\<circ> b) \<times>\<^sub>\<bullet> (c \<inter>\<^sub>\<circ> d) = (a \<times>\<^sub>\<bullet> c) \<inter>\<^sub>\<circ> (b \<times>\<^sub>\<bullet> d)"
	by auto

	lemma fproduct_vdiff: "a \<times>\<^sub>\<bullet> (b -\<^sub>\<circ> c) = (a \<times>\<^sub>\<bullet> b) -\<^sub>\<circ> (a \<times>\<^sub>\<bullet> c)" by auto

	lemma vfinite_ftimesI[intro!]:
	assumes "vfinite a" and "vfinite b"
	shows "vfinite (a \<times>\<^sub>\<bullet> b)"
	using assms(1,2)
	proof(induction arbitrary: b rule: vfinite_induct)
	case (vinsert x a')
	from vinsert(4) have "vfinite (set {x} \<times>\<^sub>\<bullet> b)"
	proof(induction rule: vfinite_induct)
	case (vinsert y b')
	have "set {x} \<times>\<^sub>\<bullet> vinsert y b' = vinsert [x, y]\<^sub>\<circ> (set {x} \<times>\<^sub>\<bullet> b')" by auto
	with vinsert(3) show ?case by simp
	qed simp
	moreover have "vinsert x a' \<times>\<^sub>\<bullet> b = (set {x} \<times>\<^sub>\<bullet> b) \<union>\<^sub>\<circ> (a' \<times>\<^sub>\<bullet> b)" by auto
	ultimately show ?case using vinsert by (auto simp: vfinite_vunionI)
	qed simp


	text\<open>\<open>ftimes\<close> and \<open>vcpower\<close>\<close>

	lemma vproduct_vpair: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i) \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
	proof
	interpret vfsequence \<open>[a, b]\<^sub>\<circ>\<close> by simp
	show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i) \<Longrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
	unfolding vcons_vdoubleton two by (elim vproduct_vdoubletonE) auto
	assume hyp: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
	then have af: "a \<in>\<^sub>\<circ> f (0\<^sub>\<nat>)" and bf: "b \<in>\<^sub>\<circ> f (1\<^sub>\<nat>)" by auto
	have dom: "\<D>\<^sub>\<circ> [a, b]\<^sub>\<circ> = set {0\<^sub>\<nat>, 1\<^sub>\<nat>}" by (auto intro!: vsubset_antisym)
	have ran: "\<R>\<^sub>\<circ> [a, b]\<^sub>\<circ> \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i)"
	unfolding two using af bf vifunion_vdoubleton by auto
	show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i)"
	apply(intro vproductI)
	subgoal using dom ran vsv_axioms unfolding two by auto
	subgoal using af bf unfolding two by (auto intro!: vsubset_antisym)
	subgoal
	unfolding two
	using hyp VSigmaE2 small_empty vcons_vdoubleton
	by (auto simp: vinsert_set_insert_eq)
	done
	qed


	text\<open>Connections.\<close>

	lemma vcpower_two_ftimes: "A ^\<^sub>\<times> 2\<^sub>\<nat> = A \<times>\<^sub>\<bullet> A"
	unfolding vcpower_def ftimes_def two by simp

	lemma vcpower_two_ftimesI[intro]:
	assumes "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A"
	shows "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
	using assms unfolding ftimes_def two by auto

	lemma vcpower_two_ftimesD[dest]:
	assumes "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
	shows "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A"
	using assms unfolding vcpower_def ftimes_def two by simp

	lemma vcpower_two_ftimesE[elim]:
	assumes "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>" and "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A \<Longrightarrow> P"
	shows P
	using assms unfolding vcpower_def ftimes_def two by simp

	lemma vfsequence_vcpower_two_vpair: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat> \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> A"
	proof(rule iffI)
	show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat> \<Longrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> A"
	by (elim vcpowerE, unfold vproduct_vpair)
	qed (intro vcpowerI, unfold vproduct_vpair)

	lemma vsv_vfsequence_two:
	assumes "vsv gf" and "\<D>\<^sub>\<circ> gf = 2\<^sub>\<nat>"
	shows "[vpfst gf, vpsnd gf]\<^sub>\<circ> = gf"
	proof-
	interpret gf: vsv gf by (auto intro: assms(1))
	show ?thesis
	by
	(
	rule sym,
	rule vsv_eqI,
	blast,
	blast,
	simp add: assms(2) nat_omega_simps,
	unfold assms(2),
	elim_in_numeral,
	all\<open>simp add: nat_omega_simps\<close>
	)
	qed

	lemma vsv_vfsequence_three:
	assumes "vsv hgf" and "\<D>\<^sub>\<circ> hgf = 3\<^sub>\<nat>"
	shows "[vpfst hgf, vpsnd hgf, vpthrd hgf]\<^sub>\<circ> = hgf"
	proof-
	interpret hgf: vsv hgf by (auto intro: assms(1))
	show ?thesis
	by
	(
	rule sym,
	rule vsv_eqI,
	blast,
	blast,
	simp add: assms(2) nat_omega_simps,
	unfold assms(2),
	elim_in_numeral,
	all\<open>simp add: nat_omega_simps\<close>
	)
	qed



	subsection\<open>Sequence as an element of a Cartesian power of a set\<close>

	lemma vcons_in_vcpowerI[intro!]:
	assumes "n \<in>\<^sub>\<circ> \<omega>"
	and "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
	and "x \<in>\<^sub>\<circ> A"
	and "n = vcard (xs #\<^sub>\<circ> x)"
	shows "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n"
	proof-
	interpret vfsequence xs
	using assms
	by
	(
	meson
	vcons_vsubset
	vfinite_vcard_omega_iff
	vfinite_vsubset
	vfsequence_vcpower
	)
	show ?thesis
	by
	(
	metis
	assms(2,3,4)
	vcpower_vrange
	vfsequence_vcons
	vfsequence_vcons_vrange
	vfsequence.vfsequence_vrange_vcpower
	vsubset_vinsert_leftI
	)
	qed

	lemma vcons_in_vcpowerD[dest]:
	assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>"
	shows "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
	and "x \<in>\<^sub>\<circ> A"
	and "n = vcard (xs #\<^sub>\<circ> x)"
	proof-
	interpret vfsequence xs
	by
	(
	meson
	assms
	vfsequence.vfsequence_vremove_vcons_vfsequence
	vfsequence_vcpower
	)
	from assms vfsequence_vcard_vcons show "n = vcard (xs #\<^sub>\<circ> x)" by auto
	then show "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
	by
	(
	metis
	assms(1)
	vcpower_vrange
	vfsequence_vcons_vrange
	vfsequence_vrange_vcpower
	vsubset_vinsert_leftD
	)
	show "x \<in>\<^sub>\<circ> A"
	by
	(
	metis
	assms(1)
	vcpower_vrange
	vfsequence.vfsequence_vcons_vrange
	vfsequence_axioms
	vinsertI1
	vsubsetE
	)
	qed

	lemma vcons_in_vcpowerE1[elim!]:
	assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>"
	obtains "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs" and "x \<in>\<^sub>\<circ> A" and "n = vcard (xs #\<^sub>\<circ> x)"
	using assms by blast

	lemma vcons_in_vcpowerE2:
	assumes "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>" and "0 \<in>\<^sub>\<circ> n"
	obtains x xs' where "xs = xs' #\<^sub>\<circ> x"
	and "xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'"
	and "x \<in>\<^sub>\<circ> A"
	and "n = vcard (xs' #\<^sub>\<circ> x)"
	proof-
	interpret vfsequence xs using assms(1,2) by auto
	from assms obtain x xs' where xs_def: "xs = xs' #\<^sub>\<circ> x"
	by
	(
	metis
	eq0_iff vcard_0 vcpower_vdomain vfsequence_vcons_ex vfsequence_vdomain
	)
	from vcons_in_vcpowerE1[OF assms(1)[unfolded xs_def] assms(2)] have
	"xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'" and "x \<in>\<^sub>\<circ> A" and "n = vcard (xs' #\<^sub>\<circ> x)"
	by blast+
	from xs_def this show ?thesis by (clarsimp simp: that)
	qed

	lemma vcons_vcpower1E: (TODO: generalize)
	assumes "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> 1\<^sub>\<nat>"
	obtains x where "xs = [x]\<^sub>\<circ>" and "x \<in>\<^sub>\<circ> A"
	proof-
	have 01: "0 \<in>\<^sub>\<circ> 1\<^sub>\<nat>" by simp
	from vcons_in_vcpowerE2[OF assms ord_of_nat_\<omega> 01] obtain x xs'
	where xs_def: "xs = xs' #\<^sub>\<circ> x"
	and xs': "xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'"
	and x: "x \<in>\<^sub>\<circ> A"
	and one: "1\<^sub>\<nat> = vcard (xs' #\<^sub>\<circ> x)"
	by metis
	interpret xs: vfsequence xs using assms by (auto intro: vfsequence_vcpower)
	interpret xs': vfsequence xs'
	using xs' xs_def xs.vfsequence_vremove_vcons_vfsequence by blast
	from one have "vcard xs' = 0"
	by (metis ord_of_nat_succ_vempty succ_inject_iff xs'.vfsequence_vcard_vcons)
	then have "xs = [x]\<^sub>\<circ>" unfolding xs_def by (simp add: vcard_vempty)
	with x that show ?thesis by simp
	qed

	+
	+
	+subsection\<open>The set of all finite sequences on a set\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition vfsequences_on :: "V \<Rightarrow> V"
	+ where "vfsequences_on X = set {x. vfsequence x \<and> (\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> x. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)}"
	+
	+lemma vfsequences_on_subset_\<omega>_set:
	+ "{x. vfsequence x \<and> (\<forall>i\<in>elts (\<D>\<^sub>\<circ> x). x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)} \<subseteq> elts (VPow (\<omega> \<times>\<^sub>\<circ> X))"
	+proof
	+ (
	+ intro subsetI,
	+ unfold mem_Collect_eq VPow_iff,
	+ elim conjE,
	+ intro vsubsetI
	+ )
	+ fix xs nx
	+ assume prems[rule_format]:
	+ "vfsequence xs"
	+ "\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> xs. xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
	+ "nx \<in>\<^sub>\<circ> xs"
	+ interpret vfsequence xs by (rule prems(1))
	+ from prems(3) vbrelation obtain n x where nx_def: "nx = \<langle>n, x\<rangle>" by auto
	+ from vsv_appI[OF prems(3)[unfolded this]] have xsn: "xs\<lparr>n\<rparr> = x" .
	+ from prems(3) nx_def have "n \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" by auto
	+ with prems(2) show "nx \<in>\<^sub>\<circ> \<omega> \<times>\<^sub>\<circ> X"
	+ by (auto simp: nx_def xsn[symmetric] Ord_trans vfsequence_vdomain_in_omega)
	+qed
	+
	+lemma small_vfsequences_on[simp]:
	+ "small {x. vfsequence x \<and> (\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> x. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)}"
	+ by (rule down, rule vfsequences_on_subset_\<omega>_set)
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma vfsequences_onI:
	+ assumes "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
	+ shows "xs \<in>\<^sub>\<circ> vfsequences_on X"
	+ using assms unfolding vfsequences_on_def by simp
	+
	+lemma vfsequences_onD[dest]:
	+ assumes "xs \<in>\<^sub>\<circ> vfsequences_on X"
	+ shows "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
	+ using assms unfolding vfsequences_on_def by auto
	+
	+lemma vfsequences_onE[elim]:
	+ assumes "xs \<in>\<^sub>\<circ> vfsequences_on X"
	+ obtains "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
	+ using assms unfolding vfsequences_on_def by auto
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma vfsequences_on_vsubset_mono:
	+ assumes "A \<subseteq>\<^sub>\<circ> B "
	+ shows "vfsequences_on A \<subseteq>\<^sub>\<circ> vfsequences_on B"
	+proof(intro vsubsetI vfsequences_onI; elim vfsequences_onE)
	+ fix i xs assume prems: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
	+ from assms prems(2)[OF prems(1)] show "xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> B" by auto
	+qed
	+
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_IF.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_IF.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_IF.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_IF.thy
	@@ -1,844 +1,904 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Operations on indexed families of sets\<close>
	theory CZH_Sets_IF
	imports CZH_Sets_BRelations
	begin



	subsection\<open>Background\<close>


	text\<open>
	This section presents results about the fundamental operations on the indexed
	families of sets, such as unions and intersections of the indexed families
	of sets, disjoint unions and infinite Cartesian products.

	Certain elements of the content of this section were inspired by
	elements of the content of \cite{paulson_hereditarily_2013}.
	However, as previously, many other results were ported (with amendments) from
	the main library of Isabelle/HOL.
	\<close>

	abbreviation (input) imVLambda :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "imVLambda A f \<equiv> (\<lambda>a\<in>\<^sub>\<circ>A. f a) `\<^sub>\<circ> A"



	subsection\<open>Intersection of an indexed family of sets\<close>

	syntax "_VIFINTER" :: "pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>(3\<Inter>\<^sub>\<circ>_\<in>\<^sub>\<circ>_./ _)\<close> [0, 0, 10] 10)

	translations "\<Inter>\<^sub>\<circ>x\<in>\<^sub>\<circ>A. f" \<rightleftharpoons> "CONST VInter (CONST imVLambda A (\<lambda>x. f))"


	text\<open>Rules.\<close>

	lemma vifintersectionI[intro]:
	assumes "I \<noteq> 0" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> a \<in>\<^sub>\<circ> f i"
	shows "a \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by (auto intro!: vsubset_antisym)

	lemma vifintersectionD[dest]:
	assumes "a \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)" and "i \<in>\<^sub>\<circ> I"
	shows "a \<in>\<^sub>\<circ> f i"
	using assms by blast

	lemma vifintersectionE1[elim]:
	assumes "a \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)" and "a \<in>\<^sub>\<circ> f i \<Longrightarrow> P" and "i \<notin>\<^sub>\<circ> I \<Longrightarrow> P"
	shows P
	using assms by blast

	lemma vifintersectionE3[elim]:
	assumes "a \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	obtains "\<And>i. i\<in>\<^sub>\<circ>I \<Longrightarrow> a \<in>\<^sub>\<circ> f i"
	using assms by blast

	lemma vifintersectionE2[elim]:
	assumes "a \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	obtains i where "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> f i"
	using assms by (elim vifintersectionE3) (meson assms VInterE2 app_vimageE)


	text\<open>Set operations.\<close>

	lemma vifintersection_vempty_is[simp]: "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>0. f i) = 0" by auto

	lemma vifintersection_vsingleton_is[simp]: "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{i}. f i) = f i"
	using elts_0 by blast

	lemma vifintersection_vdoubleton_is[simp]: "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {i, j}. f i) = f i \<inter>\<^sub>\<circ> f j"
	by
	(
	intro vsubset_antisym vsubsetI;
	(elim vifintersectionE3 \| intro vifintersectionI)
	)
	auto

	lemma vifintersection_antimono1:
	assumes "I \<noteq> 0" and "I \<subseteq>\<^sub>\<circ> J"
	shows "(\<Inter>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. f j) \<subseteq>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by blast

	lemma vifintersection_antimono2:
	assumes "I \<noteq> 0" and " I \<subseteq>\<^sub>\<circ> J" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i \<subseteq>\<^sub>\<circ> g i"
	shows "(\<Inter>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. f j) \<subseteq>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. g i)"
	using assms by blast

	lemma vifintersection_vintersection:
	assumes "I \<noteq> 0" and "J \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>J. f i) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I \<union>\<^sub>\<circ> J. f i)"
	using assms by (auto intro!: vsubset_antisym)

	lemma vifintersection_vintersection_family:
	assumes "I \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<inter>\<^sub>\<circ> B i)"
	using assms
	by (intro vsubset_antisym vsubsetI, intro vifintersectionI \| tactic\<open>all_tac\<close>)
	blast+

	lemma vifintersection_vunion:
	assumes "I \<noteq> 0" and "J \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<union>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. g j) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Inter>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. f i \<union>\<^sub>\<circ> g j)"
	using assms by (blast intro!: vsubset_antisym)

	lemma vifintersection_vinsert_is[intro, simp]:
	assumes "I \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>i \<in>\<^sub>\<circ> vinsert j I. f i) = f j \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	apply(insert assms, intro vsubset_antisym vsubsetI)
	subgoal for b by (subgoal_tac \<open>b \<in>\<^sub>\<circ> f j\<close> \<open>b \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)\<close>) blast+
	subgoal for b
	by (subgoal_tac \<open>b \<in>\<^sub>\<circ> f j\<close> \<open>b \<in>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)\<close>)
	(blast intro!: vsubset_antisym)+
	done

	lemma vifintersection_VPow:
	assumes "I \<noteq> 0"
	shows "VPow (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. VPow (f i))"
	using assms by (auto intro!: vsubset_antisym)


	text\<open>Elementary properties.\<close>

	lemma vifintersection_constant[intro, simp]:
	assumes "I \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>y\<in>\<^sub>\<circ>I. c) = c"
	using assms by auto

	lemma vifintersection_vsubset_iff:
	assumes "I \<noteq> 0"
	shows "A \<subseteq>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<longleftrightarrow> (\<forall>i\<in>\<^sub>\<circ>I. A \<subseteq>\<^sub>\<circ> f i)"
	using assms by blast

	lemma vifintersection_vsubset_lower:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<subseteq>\<^sub>\<circ> f i"
	using assms by blast

	lemma vifintersection_vsubset_greatest:
	assumes "I \<noteq> 0" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A \<subseteq>\<^sub>\<circ> f i"
	shows "A \<subseteq>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by (intro vsubsetI vifintersectionI) auto

	lemma vifintersection_vintersection_value:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "f i \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by blast

	lemma vifintersection_vintersection_single:
	assumes "I \<noteq> 0"
	shows "B \<union>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) = (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B \<union>\<^sub>\<circ> A i)"
	by (insert assms, intro vsubset_antisym vsubsetI vifintersectionI)
	blast+


	text\<open>Connections.\<close>

	lemma vifintersection_vrange_VLambda: "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = \<Inter>\<^sub>\<circ> (\<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>I. f a))"
	by (simp add: vimage_VLambda_vrange_rep)



	subsection\<open>Union of an indexed family of sets\<close>

	syntax "_VIFUNION" :: "pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>(3\<Union>\<^sub>\<circ>_\<in>\<^sub>\<circ>_./ _)\<close> [0, 0, 10] 10)

	translations "\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A. f" \<rightleftharpoons> "CONST VUnion (CONST imVLambda A (\<lambda>x. f))"


	text\<open>Rules.\<close>

	lemma vifunion_iff: "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<longleftrightarrow> (\<exists>i\<in>\<^sub>\<circ>I. b \<in>\<^sub>\<circ> f i)" by force

	lemma vifunionI[intro]:
	assumes "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> f i"
	shows "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by force

	lemma vifunionD[dest]:
	assumes "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	shows "\<exists>i\<in>\<^sub>\<circ>I. a \<in>\<^sub>\<circ> f i"
	using assms by auto

	lemma vifunionE[elim!]:
	assumes "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)" and "\<And>i. \<lbrakk> i \<in>\<^sub>\<circ> I; a \<in>\<^sub>\<circ> f i \<rbrakk> \<Longrightarrow> R"
	shows R
	using assms by auto


	text\<open>Set operations.\<close>

	lemma vifunion_vempty_family[simp]: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. 0) = 0" by auto

	lemma vifunion_vsingleton_is[simp]: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {i}. f i) = f i" by force

	lemma vifunion_vsingleton_family[simp]: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. set {i}) = I" by force

	lemma vifunion_vdoubleton: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {i, j}. f i) = f i \<union>\<^sub>\<circ> f j"
	using VLambda_vinsert vimage_vunion_left
	by (force simp: VLambda_vsingleton simp: vinsert_set_insert_eq)

	lemma vifunion_mono:
	assumes "I \<subseteq>\<^sub>\<circ> J" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i \<subseteq>\<^sub>\<circ> g i"
	shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. g j)"
	using assms by force

	lemma vifunion_vunion_is: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. f j) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I \<union>\<^sub>\<circ> J. f i)"
	by force

	lemma vifunion_vunion_family:
	"(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. g i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i \<union>\<^sub>\<circ> g i)"
	by (intro vsubset_antisym vsubsetI; elim vunionE vifunionE) force+

	lemma vifunion_vintersection:
	"(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<inter>\<^sub>\<circ> (\<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. g j) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. f i \<inter>\<^sub>\<circ> g j)"
	by (force simp: vrange_VLambda vimage_VLambda_vrange_rep)

	lemma vifunion_vinsert_is:
	"(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>vinsert j I. f i) = f j \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	by (force simp: vimage_VLambda_vrange_rep)

	lemma vifunion_VPow: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. VPow (f i)) \<subseteq>\<^sub>\<circ> VPow (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)" by force


	text\<open>Elementary properties.\<close>

	lemma vifunion_vempty_conv:
	"0 = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<longleftrightarrow> (\<forall>i\<in>\<^sub>\<circ>I. f i = 0)"
	"(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = 0 \<longleftrightarrow> (\<forall>i\<in>\<^sub>\<circ>I. f i = 0)"
	by (auto simp: vrange_VLambda vimage_VLambda_vrange_rep)

	lemma vifunion_constant[simp]: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. c) = (if I = 0 then 0 else c)"
	proof(intro vsubset_antisym)
	show "(if I = 0 then 0 else c) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. c)"
	by (cases \<open>vdisjnt I I\<close>) (auto simp: VLambda_vconst_on)
	qed auto

	lemma vifunion_upper:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "f i \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by force

	lemma vifunion_least:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i \<subseteq>\<^sub>\<circ> C"
	shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<subseteq>\<^sub>\<circ> C"
	using assms by auto

	lemma vifunion_absorb:
	assumes "j \<in>\<^sub>\<circ> I"
	shows "f j \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	using assms by force

	lemma vifunion_vifunion_flatten:
	"(\<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i). g j) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Union>\<^sub>\<circ>j\<in>\<^sub>\<circ>f i. g j)"
	by (force simp: vrange_VLambda vimage_VLambda_vrange_rep)

	lemma vifunion_vsubset_iff: "((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<subseteq>\<^sub>\<circ> B) = (\<forall>i\<in>\<^sub>\<circ>I. f i \<subseteq>\<^sub>\<circ> B)" by force

	lemma vifunion_vsingleton_eq_vrange: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. set {f i}) = \<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>I. f a)"
	by force

	lemma vball_vifunion[simp]: "(\<forall>z\<in>\<^sub>\<circ>(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i). P z) \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>I. \<forall>z\<in>\<^sub>\<circ>f x. P z)"
	by force

	lemma vbex_vifunion[simp]: "(\<exists>z\<in>\<^sub>\<circ>(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i). P z) \<longleftrightarrow> (\<exists>x\<in>\<^sub>\<circ>I. \<exists>z\<in>\<^sub>\<circ>f x. P z)"
	by force

	lemma vifunion_vintersection_index_right[simp]: "(\<Union>\<^sub>\<circ>C\<in>\<^sub>\<circ>B. A \<inter>\<^sub>\<circ> C) = A \<inter>\<^sub>\<circ> \<Union>\<^sub>\<circ>B"
	by (force simp: vimage_VLambda_vrange_rep)

	lemma vifunion_vintersection_index_left[simp]: "(\<Union>\<^sub>\<circ>C\<in>\<^sub>\<circ>B. C \<inter>\<^sub>\<circ> A) = \<Union>\<^sub>\<circ>B \<inter>\<^sub>\<circ> A"
	by (force simp: vimage_VLambda_vrange_rep)

	lemma vifunion_vunion_index[intro, simp]:
	assumes "B \<noteq> 0"
	shows "(\<Inter>\<^sub>\<circ>C\<in>\<^sub>\<circ>B. A \<union>\<^sub>\<circ> C) = A \<union>\<^sub>\<circ> \<Inter>\<^sub>\<circ>B"
	using assms
	by
	(
	(intro vsubset_antisym vsubsetI);
	(intro vifintersectionI \| tactic\<open>all_tac\<close>)
	)
	blast+

	lemma vifunion_vintersection_single: "B \<inter>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B \<inter>\<^sub>\<circ> f i)"
	by (force simp: vrange_VLambda vimage_VLambda_vrange_rep)

	lemma vifunion_vifunion_flip:
	"(\<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. \<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. f b a) = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. f b a)"
	proof-
	have "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. f b a)" if "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. \<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. f b a)"
	for x f A B
	proof-
	from that obtain b where b: "b \<in>\<^sub>\<circ> B" and x_b: "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. f b a)"
	by fastforce
	then obtain a where a: "a \<in>\<^sub>\<circ> A" and x_fba: "x \<in>\<^sub>\<circ> f b a" by fastforce
	show "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. f b a)"
	unfolding vifunion_iff by (auto intro: a b x_fba)
	qed
	then show ?thesis by (intro vsubset_antisym vsubsetI) auto
	qed


	text\<open>Connections.\<close>

	lemma vifunion_disjoint: "(\<Union>\<^sub>\<circ>C \<inter>\<^sub>\<circ> A = 0) \<longleftrightarrow> (\<forall>B\<in>\<^sub>\<circ>C. vdisjnt B A)"
	by (intro iffI)
	(auto intro!: vsubset_antisym simp: Sup_upper vdisjnt_vsubset_left)

	lemma vdisjnt_vifunion_iff:
	"vdisjnt A (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<longleftrightarrow> (\<forall>i\<in>\<^sub>\<circ>I. vdisjnt A (f i))"
	by (force intro!: vsubset_antisym simp: vdisjnt_iff)+

	lemma vifunion_VLambda: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>A. set {\<langle>i, f i\<rangle>}) = (\<lambda>a\<in>\<^sub>\<circ>A. f a)"
	using vifunionI by (intro vsubset_antisym vsubsetI) auto

	lemma vifunion_vrange_VLambda: "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = \<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (\<lambda>a\<in>\<^sub>\<circ>I. f a))"
	using vimage_VLambda_vrange_rep by auto

	lemma (in vsv) vsv_vrange_vsubset_vifunion_app:
	assumes "\<D>\<^sub>\<circ> r = I" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> r\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	shows "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	with assms(1) obtain i where x_def: "x = r\<lparr>i\<rparr>" and i: "i \<in>\<^sub>\<circ> I"
	by (metis vrange_atE)
	from i assms(2)[rule_format, OF i] show "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	unfolding x_def by (intro vifunionI) auto
	qed

	lemma v11_vlrestriction_vifintersection:
	assumes "I \<noteq> 0" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> v11 (f \<restriction>\<^sup>l\<^sub>\<circ> (A i))"
	shows "v11 (f \<restriction>\<^sup>l\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i))"
	proof(intro v11I)
	show "vsv (f \<restriction>\<^sup>l\<^sub>\<circ> \<Inter>\<^sub>\<circ> ((\<lambda>a\<in>\<^sub>\<circ>I. A a) `\<^sub>\<circ> I))"
	(slow)
	apply(subgoal_tac \<open>\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> vsv (f \<restriction>\<^sup>l\<^sub>\<circ> (A i))\<close>)
	subgoal by (insert assms(1), intro vsvI) (blast intro!: vsubset_antisym)+
	subgoal using assms by blast
	done
	show "vsv ((f \<restriction>\<^sup>l\<^sub>\<circ> \<Inter>\<^sub>\<circ> ((\<lambda>a\<in>\<^sub>\<circ>I. A a) `\<^sub>\<circ> I))\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	fix a b c
	assume ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> (f \<restriction>\<^sup>l\<^sub>\<circ> \<Inter>\<^sub>\<circ> ((\<lambda>a\<in>\<^sub>\<circ>I. A a) `\<^sub>\<circ> I))\<inverse>\<^sub>\<circ>"
	and ac: "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> (f \<restriction>\<^sup>l\<^sub>\<circ> \<Inter>\<^sub>\<circ> ((\<lambda>a\<in>\<^sub>\<circ>I. A a) `\<^sub>\<circ> I))\<inverse>\<^sub>\<circ>"
	from assms(2) have hyp: "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> vsv ((f \<restriction>\<^sup>l\<^sub>\<circ> (A i))\<inverse>\<^sub>\<circ>)" by blast
	from assms(1) obtain i where "i \<in>\<^sub>\<circ> I" and "\<Inter>\<^sub>\<circ> ((\<lambda>a\<in>\<^sub>\<circ>I. A a) `\<^sub>\<circ> I) \<subseteq>\<^sub>\<circ> A i"
	by (auto intro!: vsubset_antisym)
	with ab ac hyp \<open>i \<in>\<^sub>\<circ> I\<close> show "b = c" by auto
	qed auto
	qed



	subsection\<open>Additional simplification rules for indexed families of sets.\<close>


	text\<open>Union.\<close>

	lemma vifunion_simps[simp]:
	"\<And>a B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. vinsert a (B i)) =
	(if I=0 then 0 else vinsert a (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i))"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<union>\<^sub>\<circ> B) = ((if I=0 then 0 else (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<union>\<^sub>\<circ> B))"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<union>\<^sub>\<circ> B i) = ((if I=0 then 0 else A \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i)))"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<inter>\<^sub>\<circ> B) = ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<inter>\<^sub>\<circ> B)"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<inter>\<^sub>\<circ> B i) = (A \<inter>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i))"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i -\<^sub>\<circ> B) = ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) -\<^sub>\<circ> B)"
	"\<And>A B. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<Union>\<^sub>\<circ>A. B i) = (\<Union>\<^sub>\<circ>y\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>y. B i)"
	by
	(
	force
	simp: vrange_VLambda vimage_VLambda_vrange_rep
	intro!: vsubset_antisym
	)+

	lemma vifunion_simps_ext:
	"\<And>a B I. vinsert a (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) =
	(if I=0 then set {a} else (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. vinsert a (B i)))"
	"\<And>A B I. (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<union>\<^sub>\<circ> B = (if I=0 then B else (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<union>\<^sub>\<circ> B))"
	"\<And>A B I. A \<union>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) = (if I=0 then A else (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<union>\<^sub>\<circ> B i))"
	"\<And>A B I. ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<inter>\<^sub>\<circ> B) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<inter>\<^sub>\<circ> B)"
	"\<And>A B I. ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) -\<^sub>\<circ> B) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i -\<^sub>\<circ> B)"
	"\<And>A B. (\<Union>\<^sub>\<circ>y\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>y. B i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<Union>\<^sub>\<circ>A. B i)"
	by (auto simp: vrange_VLambda)

	lemma vifunion_vball_vbex_simps[simp]:
	"\<And>A P. (\<forall>a\<in>\<^sub>\<circ>\<Union>\<^sub>\<circ>A. P a) \<longleftrightarrow> (\<forall>y\<in>\<^sub>\<circ>A. \<forall>a\<in>\<^sub>\<circ>y. P a)"
	"\<And>A P. (\<exists>a\<in>\<^sub>\<circ>\<Union>\<^sub>\<circ>A. P a) \<longleftrightarrow> (\<exists>y\<in>\<^sub>\<circ>A. \<exists>a\<in>\<^sub>\<circ>y. P a)"
	using vball_vifunion vbex_vifunion by auto


	text\<open>Intersection.\<close>

	lemma vifintersection_simps[simp]:
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<inter>\<^sub>\<circ> B) = (if I = 0 then 0 else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<inter>\<^sub>\<circ> B)"
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<inter>\<^sub>\<circ> B i) = (if I = 0 then 0 else A \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i))"
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i -\<^sub>\<circ> B) = (if I = 0 then 0 else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) -\<^sub>\<circ> B)"
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A -\<^sub>\<circ> B i) = (if I = 0 then 0 else A -\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i))"
	"\<And>I a B.
	(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. vinsert a (B i)) = (if I = 0 then 0 else vinsert a (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i))"
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<union>\<^sub>\<circ> B) = (if I = 0 then 0 else ((\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<union>\<^sub>\<circ> B))"
	"\<And>I A B. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<union>\<^sub>\<circ> B i) = (if I = 0 then 0 else (A \<union>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i)))"
	by force+

	lemma vifintersection_simps_ext:
	"\<And>A B I. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<inter>\<^sub>\<circ> B = (if I = 0 then 0 else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<inter>\<^sub>\<circ> B))"
	"\<And>A B I. A \<inter>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) = (if I = 0 then 0 else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<inter>\<^sub>\<circ> B i))"
	"\<And>A B I. (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) -\<^sub>\<circ> B = (if I = 0 then 0 else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i -\<^sub>\<circ> B))"
	"\<And>A B I. A -\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) = (if I = 0 then A else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A -\<^sub>\<circ> B i))"
	"\<And>a B I. vinsert a (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) =
	(if I = 0 then set {a} else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. vinsert a (B i)))"
	"\<And>A B I. ((\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<union>\<^sub>\<circ> B) = (if I = 0 then B else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i \<union>\<^sub>\<circ> B))"
	"\<And>A B I. A \<union>\<^sub>\<circ> (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. B i) = (if I = 0 then A else (\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A \<union>\<^sub>\<circ> B i))"
	using vifintersection_simps by auto



	subsection\<open>Knowledge transfer: union and intersection of indexed families\<close>

	lemma SUP_vifunion: "(SUP \<xi>\<in>elts \<alpha>. A \<xi>) = (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. A \<xi>)"
	by (simp add: vimage_VLambda_vrange_rep vrange_VLambda)

	lemma INF_vifintersection: "(INF \<xi>\<in>elts \<alpha>. A \<xi>) = (\<Inter>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. A \<xi>)"
	by (simp add: vimage_VLambda_vrange_rep vrange_VLambda)

	lemmas Ord_induct3'[consumes 1, case_names 0 succ Limit, induct type: V] =
	Ord_induct3[unfolded SUP_vifunion]

	lemma Limit_vifunion_def[simp]:
	assumes "Limit \<alpha>"
	shows "(\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. \<xi>) = \<alpha>"
	using assms unfolding SUP_vifunion[symmetric] by simp

	lemmas_with[unfolded SUP_vifunion INF_vifintersection]:
	TC = ZFC_Cardinals.TC
	and rank_Sup = ZFC_Cardinals.rank_Sup
	and TC_def = ZFC_Cardinals.TC_def
	and Ord_equality = ZFC_in_HOL.Ord_equality
	and Aleph_Limit = ZFC_Cardinals.Aleph_Limit
	and rank = ZFC_Cardinals.rank
	and Vset = ZFC_in_HOL.Vset
	and mult = Kirby.mult
	and Aleph_def = ZFC_Cardinals.Aleph_def
	and times_V_def = Kirby.times_V_def
	and mult_Limit = Kirby.mult_Limit
	and Vfrom = ZFC_in_HOL.Vfrom
	and Vfrom_def = ZFC_in_HOL.Vfrom_def
	and rank_def = ZFC_Cardinals.rank_def
	and add_Limit = Kirby.add_Limit
	and Limit_Vfrom_eq = ZFC_in_HOL.Limit_Vfrom_eq
	and VSigma_def = ZFC_Cardinals.VSigma_def
	and add_Sup_distrib_id = Kirby.add_Sup_distrib_id
	and Limit_add_Sup_distrib = Kirby.Limit_add_Sup_distrib
	and TC_mult = Kirby.TC_mult
	and add_Sup_distrib = Kirby.add_Sup_distrib



	subsection\<open>Disjoint union\<close>


	text\<open>
	-Fundamental properties have already been exposed in the main library
	-of \<open>ZFC in HOL\<close>.
	+See the main library of \<open>ZFC in HOL\<close> for further information
	+and elementary properties.
	\<close>

	-syntax "_VPRODUCT" :: "pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>(3\<Coprod>\<^sub>\<times>_\<in>\<^sub>\<circ>_./ _)\<close> [0, 0, 10] 10)
	+syntax "_VSIGMA" :: "pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>(3\<Coprod>\<^sub>\<circ>_\<in>\<^sub>\<circ>_./ _)\<close> [0, 0, 10] 10)

	-translations "\<Coprod>\<^sub>\<times>i\<in>\<^sub>\<circ>I. A" \<rightleftharpoons> "CONST VSigma I (\<lambda>i. A)"
	+translations "\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A" \<rightleftharpoons> "CONST VSigma I (\<lambda>i. A)"


	text\<open>Further rules.\<close>

	-lemma vdunion_expE[elim!]:
	- assumes "c \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	- obtains i a where "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> A i" and "c = \<langle>i, a\<rangle>"
	- using assms by (clarsimp simp: vrange_VLambda vimage_VLambda_vrange_rep)
	+lemma vdunion_def: "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	+ by (auto simp: vrange_VLambda vimage_VLambda_vrange_rep)

	-lemma vdunion_def: "(\<Coprod>\<^sub>\<times>i\<in>\<^sub>\<circ>I. A i) = (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	- by (auto simp: vrange_VLambda vimage_VLambda_vrange_rep)
	+lemma vdunionI:
	+ assumes "ix = \<langle>i, x\<rangle>" and "i \<in>\<^sub>\<circ> I" and "x \<in>\<^sub>\<circ> A i"
	+ shows "ix \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+ using assms(2,3) unfolding assms(1) vdunion_def by (intro vifunionI) auto
	+
	+lemmas vdunionD = VSigmaD1 VSigmaD2
	+ and vdunionE = VSigmaE


	text\<open>Set operations.\<close>

	-lemma vdunion_vsingleton: "(\<Coprod>\<^sub>\<times>i\<in>\<^sub>\<circ>set{c}. A i) = set {c} \<times>\<^sub>\<circ> A c" by auto
	+lemma vdunion_vsingleton: "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{c}. A i) = set {c} \<times>\<^sub>\<circ> A c" by auto

	lemma vdunion_vdoubleton:
	- "(\<Coprod>\<^sub>\<times>i\<in>\<^sub>\<circ>set{a, b}. A i) = set {a} \<times>\<^sub>\<circ> A a \<union>\<^sub>\<circ> set {b} \<times>\<^sub>\<circ> A b"
	+ "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{a, b}. A i) = set {a} \<times>\<^sub>\<circ> A a \<union>\<^sub>\<circ> set {b} \<times>\<^sub>\<circ> A b"
	by auto


	text\<open>Connections.\<close>

	-lemma vdunion_vsum: "(\<Coprod>\<^sub>\<times>i\<in>\<^sub>\<circ>set{0, 1}. if i=0 then A else B) = A \<Uplus> B"
	+lemma vdunion_vsum: "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{0, 1}. if i=0 then A else B) = A \<Uplus> B"
	unfolding vdunion_vdoubleton vsum_def by simp



	+subsection\<open>Canonical injection\<close>
	+
	+definition vcinjection :: "(V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V"
	+ where "vcinjection A i = (\<lambda>x\<in>\<^sub>\<circ>A i. \<langle>i, x\<rangle>)"
	+
	+
	+text\<open>Rules.\<close>
	+
	+mk_VLambda vcinjection_def
	+ \|vsv vcinjection_vsv[intro]\|
	+ \|vdomain vcinjection_vdomain[simp]\|
	+ \|app vcinjection_app[simp, intro]\|
	+
	+
	+text\<open>Elementary results.\<close>
	+
	+lemma vcinjection_vrange_vsubset:
	+ assumes "i \<in>\<^sub>\<circ> I"
	+ shows "\<R>\<^sub>\<circ> (vcinjection A i) \<subseteq>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+ unfolding vcinjection_def
	+proof(intro vrange_VLambda_vsubset)
	+ fix x assume prems: "x \<in>\<^sub>\<circ> A i"
	+ show "\<langle>i, x\<rangle> \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	+ by (intro vdunionI[where A=A, OF _ assms prems]) simp
	+qed
	+
	+lemma vcinjection_vrange:
	+ assumes "i \<in>\<^sub>\<circ> I" and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> A j \<noteq> 0"
	+ shows "\<R>\<^sub>\<circ> (vcinjection A i) = (\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	+proof(intro vsubset_antisym)
	+ interpret vsv \<open>vcinjection A i\<close> by (rule vcinjection_vsv)
	+ show "\<R>\<^sub>\<circ> (vcinjection A i) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	+ unfolding vcinjection_def
	+ proof(intro vrange_VLambda_vsubset)
	+ fix x assume prems: "x \<in>\<^sub>\<circ> A i"
	+ show "\<langle>i, x\<rangle> \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	+ by (intro vifunionI, rule prems) simp
	+ qed
	+ show "(\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>}) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (vcinjection A i)"
	+ proof(rule vsubsetI)
	+ fix ix assume "ix \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>x\<in>\<^sub>\<circ>A i. set {\<langle>i, x\<rangle>})"
	+ then obtain x where x: "x \<in>\<^sub>\<circ> A i" and ix_def: "ix = \<langle>i, x\<rangle>"
	+ by (elim vifunionE) auto
	+ with x show "ix \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vcinjection A i)"
	+ unfolding ix_def by (intro vsv_vimageI2') auto
	+ qed
	+qed
	+
	+
	+
	subsection\<open>Infinite Cartesian product\<close>

	definition vproduct :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "vproduct I A = set {f. vsv f \<and> \<D>\<^sub>\<circ> f = I \<and> (\<forall>i\<in>\<^sub>\<circ>I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i)}"

	syntax "_VPRODUCT" :: "pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>(3\<Prod>\<^sub>\<circ>_\<in>\<^sub>\<circ>_./ _)\<close> [0, 0, 10] 10)

	translations "\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A" \<rightleftharpoons> "CONST vproduct I (\<lambda>i. A)"

	lemma small_vproduct[simp]:
	"small {f. vsv f \<and> \<D>\<^sub>\<circ> f = I \<and> (\<forall>i\<in>\<^sub>\<circ>I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i)}"
	(is \<open>small ?A\<close>)
	proof-
	from small_vsv[of I \<open>(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)\<close>] have
	"small {f. vsv f \<and> \<D>\<^sub>\<circ> f = I \<and> \<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)}"
	by simp
	moreover have "?A \<subseteq> {f. vsv f \<and> \<D>\<^sub>\<circ> f = I \<and> \<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)}"
	proof(intro subsetI, unfold mem_Collect_eq, elim conjE, intro conjI)
	fix f assume prems: "vsv f" "\<D>\<^sub>\<circ> f = I" "\<forall>i\<in>elts I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	interpret vsv f by (rule prems(1))
	show "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	with prems(2) obtain i where y_def: "y = f\<lparr>i\<rparr>" and i: "i \<in>\<^sub>\<circ> I"
	by (blast dest: vrange_atD)
	from i prems(3) vifunionI show "y \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	unfolding y_def by auto
	qed
	qed
	ultimately show ?thesis by (metis (lifting) smaller_than_small)
	qed


	text\<open>Rules.\<close>

	lemma vproductI[intro!]:
	assumes "vsv f" and "\<D>\<^sub>\<circ> f = I" and "\<forall>i\<in>\<^sub>\<circ>I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	shows "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	using assms small_vproduct unfolding vproduct_def by auto

	lemma vproductD[dest]:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	shows "vsv f"
	and "\<D>\<^sub>\<circ> f = I"
	and "\<forall>i\<in>\<^sub>\<circ>I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	using assms unfolding vproduct_def by auto

	lemma vproductE[elim!]:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	obtains "vsv f" and "\<D>\<^sub>\<circ> f = I" and "\<forall>i\<in>\<^sub>\<circ>I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	using assms unfolding vproduct_def by auto


	text\<open>Set operations.\<close>

	lemma vproduct_index_vempty[simp]: "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>0. A i) = set {0}"
	proof-
	have "{f. vsv f \<and> \<D>\<^sub>\<circ> f = 0 \<and> (\<forall>i\<in>\<^sub>\<circ>0. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i)} = {0}"
	using vbrelation.vlrestriction_vdomain vsv_eqI by fastforce
	then show ?thesis unfolding vproduct_def by simp
	qed

	lemma vproduct_vsingletonI:
	assumes "f\<lparr>c\<rparr> \<in>\<^sub>\<circ> A c" and "f = set {\<langle>c, f\<lparr>c\<rparr>\<rangle>}"
	shows "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{c}. A i)"
	using assms
	apply(intro vproductI)
	subgoal by (metis rel_vsingleton.vsv_axioms)
	subgoal by (force intro!: vsubset_antisym)
	subgoal by auto
	done

	lemma vproduct_vsingletonD:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{c}. A i)"
	shows "vsv f" and "f\<lparr>c\<rparr> \<in>\<^sub>\<circ> A c" and "f = set {\<langle>c, f\<lparr>c\<rparr>\<rangle>}"
	proof-
	from assms show "f = set {\<langle>c, f\<lparr>c\<rparr>\<rangle>}"
	by (elim vproductE) (metis VLambda_vsingleton vsv.vsv_is_VLambda)
	qed (use assms in auto)

	lemma vproduct_vsingletonE:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{c}. A i)"
	obtains "vsv f" and "f\<lparr>c\<rparr> \<in>\<^sub>\<circ> A c" and "f = set {\<langle>c, f\<lparr>c\<rparr>\<rangle>}"
	using assms vproduct_vsingletonD that by auto

	lemma vproduct_vsingleton_iff:
	"f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{c}. A i) \<longleftrightarrow> f\<lparr>c\<rparr> \<in>\<^sub>\<circ> A c \<and> f = set {\<langle>c, f\<lparr>c\<rparr>\<rangle>}"
	by (rule iffI) (auto simp: vproduct_vsingletonD intro!: vproduct_vsingletonI)

	lemma vproduct_vdoubletonI[intro]:
	assumes "vsv f"
	and "f\<lparr>a\<rparr> \<in>\<^sub>\<circ> A a"
	and "f\<lparr>b\<rparr> \<in>\<^sub>\<circ> A b"
	and "\<D>\<^sub>\<circ> f = set {a, b}"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A a \<union>\<^sub>\<circ> A b"
	shows "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {a, b}. A i)"
	using assms vifunion_vdoubleton by (intro vproductI) auto

	lemma vproduct_vdoubletonD[dest]:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{a, b}. A i)"
	shows "vsv f"
	and "f\<lparr>a\<rparr> \<in>\<^sub>\<circ> A a"
	and "f\<lparr>b\<rparr> \<in>\<^sub>\<circ> A b"
	and "\<D>\<^sub>\<circ> f = set {a, b}"
	and "f = set {\<langle>a, f\<lparr>a\<rparr>\<rangle>, \<langle>b, f\<lparr>b\<rparr>\<rangle>}"
	subgoal using assms by auto
	subgoal using assms by auto
	subgoal using assms by auto
	subgoal using assms vifunion_vdoubleton by fastforce
	subgoal by (metis assms VLambda_vdoubleton vproductE vsv.vsv_is_VLambda)
	done

	lemma vproduct_vdoubletonE:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set{a, b}. A i)"
	obtains "vsv f"
	and "f\<lparr>a\<rparr> \<in>\<^sub>\<circ> A a"
	and "f\<lparr>b\<rparr> \<in>\<^sub>\<circ> A b"
	and "\<D>\<^sub>\<circ> f = set {a, b}"
	and "f = set {\<langle>a, f\<lparr>a\<rparr>\<rangle>, \<langle>b, f\<lparr>b\<rparr>\<rangle>}"
	using assms vproduct_vdoubletonD that by simp

	lemma vproduct_vdoubleton_iff:
	"f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {a, b}. A i) \<longleftrightarrow>
	vsv f \<and>
	f\<lparr>a\<rparr> \<in>\<^sub>\<circ> A a \<and>
	f\<lparr>b\<rparr> \<in>\<^sub>\<circ> A b \<and>
	\<D>\<^sub>\<circ> f = set {a, b} \<and>
	f = set {\<langle>a, f\<lparr>a\<rparr>\<rangle>, \<langle>b, f\<lparr>b\<rparr>\<rangle>}"
	by (force elim!: vproduct_vdoubletonE)+


	text\<open>Elementary properties.\<close>

	lemma vproduct_eq_vemptyI:
	assumes "i \<in>\<^sub>\<circ> I" and "A i = 0"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) = 0"
	proof(intro vsubset_antisym vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	from assms vproductD(3)[OF prems] show "x \<in>\<^sub>\<circ> 0" by auto
	qed auto

	lemma vproduct_eq_vemptyD:
	assumes "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<noteq> 0"
	shows "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<noteq> 0"
	proof(rule ccontr, unfold not_not)
	fix i assume prems: "i \<in>\<^sub>\<circ> I" "A i = 0"
	with vproduct_eq_vemptyI[where A=A, OF prems] assms show False by simp
	qed

	lemma vproduct_vrange:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	shows "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	proof(intro vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	have vsv_f: "vsv f"
	and dom_f: "\<D>\<^sub>\<circ> f = I"
	and fi: "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	by (simp_all add: vproductD[OF assms, rule_format])
	interpret f: vsv f by (rule vsv_f)
	from prems dom_f obtain i where x_def: "x = f\<lparr>i\<rparr>" and i: "i \<in>\<^sub>\<circ> I"
	by (auto elim: f.vrange_atE)
	from i fi show "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)" unfolding x_def by (intro vifunionI) auto
	qed

	lemma vproduct_vsubset_VPow: "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i))"
	proof(intro vsubsetI)
	fix f assume "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	then have vsv: "vsv f"
	and domain: "\<D>\<^sub>\<circ> f = I"
	and range: "\<forall>i\<in>elts I. f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
	by auto
	interpret f: vsv f by (rule vsv)
	have "f \<subseteq>\<^sub>\<circ> I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	proof(intro vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> f"
	then obtain a b where x_def: "x = \<langle>a, b\<rangle>" by (elim f.vbrelation_vinE)
	with prems have "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f" by auto
	with range domain prems show "x \<in>\<^sub>\<circ> I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	by (fastforce simp: x_def)
	qed
	then show "f \<in>\<^sub>\<circ> VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i))" by simp
	qed

	lemma VLambda_in_vproduct:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i \<in>\<^sub>\<circ> A i"
	shows "(\<lambda>i\<in>\<^sub>\<circ>I. f i) \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	using assms by (simp add: vproductI vsv.vsv_vrange_vsubset_vifunion_app)

	lemma vproduct_cong:
	assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i = g i"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. g i)"
	proof-
	have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. g i)" if "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> f i = g i" for f g
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. f i)"
	note xD = vproductD[OF this]
	interpret vsv x by (rule xD(1))
	show "x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. g i)"
	by (metis xD(2,3) that VLambda_in_vproduct vsv_is_VLambda)
	qed
	with assms show ?thesis by (intro vsubset_antisym) auto
	qed

	lemma vproduct_ex_in_vproduct:
	assumes "x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>J. A i)" and "J \<subseteq>\<^sub>\<circ> I" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<noteq> 0"
	obtains X where "X \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)" and "x = X \<restriction>\<^sup>l\<^sub>\<circ> J"
	proof-
	define X where "X = (\<lambda>i\<in>\<^sub>\<circ>I. if i \<in>\<^sub>\<circ> J then x\<lparr>i\<rparr> else (SOME x. x \<in>\<^sub>\<circ> A i))"
	have X: "X \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	by (intro vproductI) (use assms in \<open>auto simp: X_def\<close>)
	moreover have "x = X \<restriction>\<^sup>l\<^sub>\<circ> J"
	proof(rule vsv_eqI)
	from assms(1) have [simp]: "\<D>\<^sub>\<circ> x = J" by clarsimp
	moreover from assms(2) have "\<D>\<^sub>\<circ> (X \<restriction>\<^sup>l\<^sub>\<circ> J) = J" unfolding X_def by fastforce
	ultimately show "\<D>\<^sub>\<circ> x = \<D>\<^sub>\<circ> (X \<restriction>\<^sup>l\<^sub>\<circ> J)" by simp
	show "x\<lparr>i\<rparr> = (X \<restriction>\<^sup>l\<^sub>\<circ> J)\<lparr>i\<rparr>" if "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> x" for i
	using that assms(2) unfolding X_def by auto
	qed (use assms X in auto)
	ultimately show ?thesis using that by simp
	qed

	lemma vproduct_vsingleton_def: "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {j}. A i) = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {j}. A j)"
	by auto

	lemma vprojection_in_VUnionI:
	assumes "A \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)" and "f \<in>\<^sub>\<circ> A" and "i \<in>\<^sub>\<circ> I"
	shows "f\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))"
	proof(intro VUnionI)
	show "f \<in>\<^sub>\<circ> A" by (rule assms(2))
	from assms(1,2) have "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)" by auto
	note f = vproductD[OF this, rule_format]
	interpret vsv f rewrites "\<D>\<^sub>\<circ> f = I" by (auto intro: f(1) simp: f(2))
	show "\<langle>i, f\<lparr>i\<rparr>\<rangle> \<in>\<^sub>\<circ> f" by (meson assms(3) vsv_appE)
	show "set {i, f\<lparr>i\<rparr>} \<in>\<^sub>\<circ> \<langle>i, f\<lparr>i\<rparr>\<rangle>" unfolding vpair_def by simp
	qed simp


	subsection\<open>Projection\<close>

	definition vprojection :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V"
	where "vprojection I A i = (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i). f\<lparr>i\<rparr>)"


	text\<open>Rules.\<close>

	mk_VLambda vprojection_def
	\|vsv vprojection_vsv[intro]\|
	\|vdomain vprojection_vdomain[simp]\|
	\|app vprojection_app[simp, intro]\|


	text\<open>Elementary results.\<close>

	lemma vprojection_vrange_vsubset:
	assumes "i \<in>\<^sub>\<circ> I"
	shows "\<R>\<^sub>\<circ> (vprojection I A i) \<subseteq>\<^sub>\<circ> A i"
	unfolding vprojection_def
	proof(intro vrange_VLambda_vsubset)
	fix f assume prems: "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	show "f\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" by (intro vproductD(3)[OF prems, rule_format] assms)
	qed

	lemma vprojection_vrange:
	assumes "i \<in>\<^sub>\<circ> I" and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> A j \<noteq> 0"
	shows "\<R>\<^sub>\<circ> (vprojection I A i) = A i"
	proof
	(
	intro
	vsubset_antisym vprojection_vrange_vsubset vrange_VLambda_vsubset assms(1)
	)
	show "A i \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (vprojection I A i)"
	proof(intro vsubsetI)
	fix x assume prems: "x \<in>\<^sub>\<circ> A i"
	obtain f
	where f: "\<And>x. x \<in>\<^sub>\<circ> set {A i \| i. i \<in>\<^sub>\<circ> I} \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x"
	and "vsv f"
	using that by (rule Axiom_of_Choice)
	define f' where "f' = (\<lambda>j\<in>\<^sub>\<circ>I. if j = i then x else f\<lparr>A j\<rparr>)"
	show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vprojection I A i)"
	unfolding vprojection_def
	proof(rule rel_VLambda.vsv_vimageI2')
	show "f' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>vproduct I A. f\<lparr>i\<rparr>)"
	unfolding vdomain_VLambda
	proof(intro vproductI, unfold Ball_def; (intro allI conjI impI)?)
	fix j assume "j \<in>\<^sub>\<circ> I"
	with prems assms(2) show "f'\<lparr>j\<rparr> \<in>\<^sub>\<circ> A j"
	unfolding f'_def by (cases \<open>j = i\<close>) (auto intro!: f)
	qed (simp_all add: f'_def)
	with assms(1) show "x = (\<lambda>f\<in>\<^sub>\<circ>vproduct I A. f\<lparr>i\<rparr>)\<lparr>f'\<rparr>"
	unfolding f'_def by simp
	qed
	qed
	qed



	subsection\<open>Cartesian power of a set\<close>

	definition vcpower :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>^\<^sub>\<times>\<close> 80)
	where "A ^\<^sub>\<times> n = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A)"


	text\<open>Rules.\<close>

	lemma vcpowerI[intro]:
	assumes "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A)"
	shows "f \<in>\<^sub>\<circ> (A ^\<^sub>\<times> n)"
	using assms unfolding vcpower_def by auto

	lemma vcpowerD[dest]:
	assumes "f \<in>\<^sub>\<circ> (A ^\<^sub>\<times> n)"
	shows "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A)"
	using assms unfolding vcpower_def by auto

	lemma vcpowerE[elim]:
	assumes "f \<in>\<^sub>\<circ> (A ^\<^sub>\<times> n)" and "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A) \<Longrightarrow> P"
	shows P
	using assms unfolding vcpower_def by auto


	text\<open>Set operations.\<close>

	lemma vcpower_index_vempty[simp]: "A ^\<^sub>\<times> 0 = set {0}"
	unfolding vcpower_def by (rule vproduct_index_vempty)

	lemma vcpower_of_vempty:
	assumes "n \<noteq> 0"
	shows "0 ^\<^sub>\<times> n = 0"
	using assms unfolding vcpower_def vproduct_def by simp

	+lemma vcpower_vsubset_mono:
	+ assumes "A \<subseteq>\<^sub>\<circ> B"
	+ shows "A ^\<^sub>\<times> n \<subseteq>\<^sub>\<circ> B ^\<^sub>\<times> n"
	+ using assms
	+ by (intro vsubsetI vcpowerI vproductI)
	+ (auto intro: vproductD[OF vcpowerD, rule_format])
	+

	text\<open>Connections.\<close>

	lemma vcpower_vdomain:
	assumes "f \<in>\<^sub>\<circ> (A ^\<^sub>\<times> n)"
	shows "\<D>\<^sub>\<circ> f = n"
	using assms by auto

	lemma vcpower_vrange:
	assumes "f \<in>\<^sub>\<circ> (A ^\<^sub>\<times> n)"
	shows "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms by (intro vsubsetI; elim vcpowerE vproductE) auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_Introduction.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_Introduction.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_Introduction.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_Introduction.thy
	@@ -1,108 +1,110 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	chapter\<open>Set Theory for Category Theory\<close>

	section\<open>Introduction\<close>
	theory CZH_Sets_Introduction
	imports
	CZH_Introduction
	CZH_Sets_MIF
	CZH_Utilities
	Intro_Dest_Elim.IHOL_IDE
	Conditional_Simplification.IHOL_CS
	ZFC_in_HOL.Cantor_NF
	"HOL-Eisbach.Eisbach"
	begin



	subsection\<open>Background\<close>


	text\<open>
	This chapter presents a formalization of the elements of set theory in
	the object logic \<open>ZFC in HOL\<close> (\cite{paulson_zermelo_2019}, also see
	\cite{barkaoui_partizan_2006})
	of the formal proof assistant Isabelle \cite{paulson_natural_1986}.
	The emphasis of this work is on the improvement of the convenience of the
	formalization of abstract mathematics internalized in the type \<^typ>\<open>V\<close>.
	\<close>



	subsection\<open>References, related and previous work\<close>


	text\<open>
	The results that are presented in this chapter cannot be traced to a single
	source of information. Nonetheless, the results are not original.
	A significant number of these results was carried over (with amendments)
	from the main library of Isabelle/HOL \cite{noauthor_isabellehol_2020}.
	Other results were inspired by elements of the content of the books
	\<open>Introduction to Axiomatic Set Theory\<close> by G. Takeuti
	and W. M. Zaring \cite{takeuti_introduction_1971}, \<open>Theory of Sets\<close>
	by N. Bourbaki \cite{bourbaki_elements_1970} and \<open>Algebra\<close> by
	T. W. Hungerford \cite{hungerford_algebra_2003}.
	Furthermore, several online encyclopedias and forums
	(including Wikipedia \cite{noauthor_wikipedia_2001},
	ProofWiki \cite{noauthor_proofwiki_nodate},
	Encyclopedia of Mathematics \cite{noauthor_encyclopedia_nodate},
	nLab \cite{noauthor_nlab_nodate} and Mathematics Stack Exchange)
	were used consistently throughout the development of this chapter.
	Inspiration for the work presented in this chapter has also been drawn
	from a similar ongoing project
	in the formalization of mathematics in the system
	HOTG (Higher Order Tarski-Grothendieck)
	\cite{brown_higher-order_2019, chen_hotg_2021}.

	It should also be mentioned that the Isabelle/HOL and the Isabelle/ML code
	from the main distribution of Isabelle2020 and certain posts on the
	mailing list of Isabelle were frequently reused
	(with amendments) during the development of this chapter. Some of the
	specific examples of such reuse are
	\begin{itemize}
	\item The adoption of the implementation of
	the command @{command lemmas_with} that is available as part of
	the framework Types-To-Sets in the main distribution of Isabelle2020.
	\item The notation for the ``multiway-if'' was written
	by Manuel Eberl and appeared in a post on the mailing list of Isabelle:
	\cite{eberl_syntax_2021}.
	\end{itemize}
	\<close>

	hide_const (open) list.set Sum subset

	lemmas ord_of_nat_zero = ord_of_nat.simps(1)



	subsection\<open>Notation\<close>

	abbreviation (input) qm (\<open>(_ ? _ : _)\<close> [0, 0, 10] 10)
	where "C ? A : B \<equiv> if C then A else B"
	abbreviation (input) if2 where "if2 a b \<equiv> (\<lambda>i. (i = 0 ? a : b))"



	subsection\<open>Further foundational results\<close>

	lemma theD:
	assumes "\<exists>!x. P x" and "x = (THE x. P x)"
	shows "P x" and "P y \<Longrightarrow> x = y"
	using assms by (metis theI)+

	lemmas [intro] = bij_betw_imageI

	lemma bij_betwE[elim]:
	assumes "bij_betw f A B" and "\<lbrakk> inj_on f A; f ` A = B \<rbrakk> \<Longrightarrow> P"
	shows P
	using assms unfolding bij_betw_def by auto

	lemma bij_betwD[dest]:
	assumes "bij_betw f A B"
	shows "inj_on f A" and "f ` A = B"
	using assms by auto

	+lemma ex1D: "\<exists>!x. P x \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y" by clarsimp
	+
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_NOP.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_NOP.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_NOP.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_NOP.thy
	@@ -1,634 +1,658 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>\<open>n\<close>-ary operation\<close>
	theory CZH_Sets_NOP
	imports CZH_Sets_FBRelations
	begin



	subsection\<open>Partial \<open>n\<close>-ary operation\<close>

	locale pnop = vsv f for A n f :: V +
	assumes pnop_n: "n \<in>\<^sub>\<circ> \<omega>"
	and pnop_vdomain: "\<D>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> n"
	and pnop_vrange: "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"


	text\<open>Rules.\<close>

	lemma pnopI[intro]:
	assumes "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	shows "pnop A n f"
	using assms unfolding pnop_def pnop_axioms_def by blast

	lemma pnopD[dest]:
	assumes "pnop A n f"
	shows "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms unfolding pnop_def pnop_axioms_def by blast+

	lemma pnopE[elim]:
	assumes "pnop A n f"
	obtains "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms by force



	subsection\<open>Total \<open>n\<close>-ary operation\<close>

	locale nop = vsv f for A n f :: V +
	assumes nop_n: "n \<in>\<^sub>\<circ> \<omega>"
	and nop_vdomain: "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and nop_vrange: "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"

	sublocale nop \<subseteq> pnop A n f
	proof(intro pnopI)
	show "vsv f" by (rule vsv_axioms)
	show "n \<in>\<^sub>\<circ> \<omega>" by (rule nop_n)
	from nop_vdomain show "\<D>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A ^\<^sub>\<times> n" by simp
	show "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A" by (rule nop_vrange)
	qed


	text\<open>Rules.\<close>

	lemma nopI[intro]:
	assumes "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	shows "nop A n f"
	using assms unfolding nop_def nop_axioms_def by blast

	lemma nopD[dest]:
	assumes "nop A n f"
	shows "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms unfolding nop_def nop_axioms_def by blast+

	lemma nopE[elim]:
	assumes "nop A n f"
	obtains "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms by force



	subsection\<open>Injective \<open>n\<close>-ary operation\<close>

	locale nop_v11 = v11 f for A n f :: V +
	assumes nop_v11_n: "n \<in>\<^sub>\<circ> \<omega>"
	and nop_v11_vdomain: "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and nop_v11_vrange: "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"

	sublocale nop_v11 \<subseteq> nop
	proof
	show "vsv f" by (rule vsv_axioms)
	show "n \<in>\<^sub>\<circ> \<omega>" by (rule nop_v11_n)
	show "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n" by (rule nop_v11_vdomain)
	show "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A" by (rule nop_v11_vrange)
	qed


	text\<open>Rules.\<close>

	lemma nop_v11I[intro]:
	assumes "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	shows "nop_v11 A n f"
	using assms unfolding nop_v11_def nop_v11_axioms_def by blast

	lemma nop_v11D[dest]:
	assumes "nop_v11 A n f"
	shows "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms unfolding nop_v11_def nop_v11_axioms_def by blast+

	lemma nop_v11E[elim]:
	assumes "nop_v11 A n f"
	obtains "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A"
	using assms by force



	subsection\<open>Surjective \<open>n\<close>-ary operation\<close>

	locale nop_onto = vsv f for A n f :: V +
	assumes nop_onto_n: "n \<in>\<^sub>\<circ> \<omega>"
	and nop_onto_vdomain: "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and nop_onto_vrange: "\<R>\<^sub>\<circ> f = A"

	sublocale nop_onto \<subseteq> nop
	proof
	show "vsv f" by (rule vsv_axioms)
	show "n \<in>\<^sub>\<circ> \<omega>" by (rule nop_onto_n)
	show "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n" by (rule nop_onto_vdomain)
	show "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A" by (simp add: nop_onto_vrange)
	qed


	text\<open>Rules.\<close>

	lemma nop_ontoI[intro]:
	assumes "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	shows "nop_onto A n f"
	using assms unfolding nop_onto_def nop_onto_axioms_def by blast

	lemma nop_ontoD[dest]:
	assumes "nop_onto A n f"
	shows "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	using assms unfolding nop_onto_def nop_onto_axioms_def by auto

	lemma nop_ontoE[elim]:
	assumes "nop_onto A n f"
	obtains "vsv f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	using assms by force



	subsection\<open>Bijective \<open>n\<close>-ary operation\<close>

	locale nop_bij = v11 f for A n f :: V +
	assumes nop_bij_n: "n \<in>\<^sub>\<circ> \<omega>"
	and nop_bij_vdomain: "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and nop_bij_vrange: "\<R>\<^sub>\<circ> f = A"

	sublocale nop_bij \<subseteq> nop_v11
	proof
	show "v11 f" by (rule v11_axioms)
	show "n \<in>\<^sub>\<circ> \<omega>" by (rule nop_bij_n)
	show "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n" by (rule nop_bij_vdomain)
	show "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> A" by (simp add: nop_bij_vrange)
	qed

	sublocale nop_bij \<subseteq> nop_onto
	proof
	show "vsv f" by (rule vsv_axioms)
	show "n \<in>\<^sub>\<circ> \<omega>" by (rule nop_bij_n)
	show "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n" by (rule nop_bij_vdomain)
	show "\<R>\<^sub>\<circ> f = A" by (rule nop_bij_vrange)
	qed


	text\<open>Rules.\<close>

	lemma nop_bijI[intro]:
	assumes "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	shows "nop_bij A n f"
	using assms unfolding nop_bij_def nop_bij_axioms_def by blast

	lemma nop_bijD[dest]:
	assumes "nop_bij A n f"
	shows "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	using assms unfolding nop_bij_def nop_bij_axioms_def by auto

	lemma nop_bijE[elim]:
	assumes "nop_bij A n f"
	obtains "v11 f"
	and "n \<in>\<^sub>\<circ> \<omega>"
	and "\<D>\<^sub>\<circ> f = A ^\<^sub>\<times> n"
	and "\<R>\<^sub>\<circ> f = A"
	using assms by force



	subsection\<open>Scalar\<close>

	locale scalar =
	fixes A f
	assumes scalar_nop: "nop A 0 f"

	sublocale scalar \<subseteq> nop A 0 f
	rewrites scalar_vdomain[simp]: "A ^\<^sub>\<times> 0 = set {0}"
	by (auto simp: scalar_nop)


	text\<open>Rules.\<close>

	lemmas scalarI[intro] = scalar.intro

	lemma scalarD[dest]:
	assumes "scalar A f"
	shows "nop A 0 f"
	using assms unfolding scalar_def by auto

	lemma scalarE[elim]:
	assumes "scalar A f"
	obtains "nop A 0 f"
	using assms by auto



	subsection\<open>Unary operation\<close>

	locale unop = nop A \<open>1\<^sub>\<nat>\<close> f for A f


	text\<open>Rules.\<close>

	lemmas unopI[intro] = unop.intro

	lemma unopD[dest]:
	assumes "unop A f"
	shows "nop A (1\<^sub>\<nat>) f"
	using assms unfolding unop_def by auto

	lemma unopE[elim]:
	assumes "unop A f"
	obtains "nop A (1\<^sub>\<nat>) f"
	using assms by blast



	subsection\<open>Injective unary operation\<close>

	locale unop_v11 = nop_v11 A \<open>1\<^sub>\<nat>\<close> f for A f

	sublocale unop_v11 \<subseteq> unop A f by (intro unopI) (simp add: nop_axioms)


	text\<open>Rules.\<close>

	lemma unop_v11I[intro]:
	assumes "nop_v11 A (1\<^sub>\<nat>) f"
	shows "unop_v11 A f"
	using assms by (rule unop_v11.intro)

	lemma unop_v11D[dest]:
	assumes "unop_v11 A f"
	shows "nop_v11 A (1\<^sub>\<nat>) f"
	using assms by (rule unop_v11.axioms)

	lemma unop_v11E[elim]:
	assumes "unop_v11 A f"
	obtains "nop_v11 A (1\<^sub>\<nat>) f"
	using assms by blast



	subsection\<open>Surjective unary operation\<close>

	locale unop_onto = nop_onto A \<open>1\<^sub>\<nat>\<close> f for A f

	sublocale unop_onto \<subseteq> unop A f by (intro unopI) (simp add: nop_axioms)


	text\<open>Rules.\<close>

	lemma unop_ontoI[intro]:
	assumes "nop_onto A (1\<^sub>\<nat>) f"
	shows "unop_onto A f"
	using assms by (rule unop_onto.intro)

	lemma unop_ontoD[dest]:
	assumes "unop_onto A f"
	shows "nop_onto A (1\<^sub>\<nat>) f"
	using assms by (rule unop_onto.axioms)

	lemma unop_ontoE[elim]:
	assumes "unop_onto A f"
	obtains "nop_onto A (1\<^sub>\<nat>) f"
	using assms by blast

	lemma unop_ontoI'[intro]:
	assumes "unop A f" and "A \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	shows "unop_onto A f"
	proof-
	interpret unop A f by (rule assms(1))
	from assms(2) nop_vrange have "A = \<R>\<^sub>\<circ> f" by simp
	with assms(1) show "unop_onto A f" by auto
	qed



	subsection\<open>Bijective unary operation\<close>

	locale unop_bij = nop_bij A \<open>1\<^sub>\<nat>\<close> f for A f

	sublocale unop_bij \<subseteq> unop_v11 A f
	by (intro unop_v11I) (simp add: nop_v11_axioms)

	sublocale unop_bij \<subseteq> unop_onto A f
	by (intro unop_ontoI) (simp add: nop_onto_axioms)


	text\<open>Rules.\<close>

	lemma unop_bijI[intro]:
	assumes "nop_bij A (1\<^sub>\<nat>) f"
	shows "unop_bij A f"
	using assms by (rule unop_bij.intro)

	lemma unop_bijD[dest]:
	assumes "unop_bij A f"
	shows "nop_bij A (1\<^sub>\<nat>) f"
	using assms by (rule unop_bij.axioms)

	lemma unop_bijE[elim]:
	assumes "unop_bij A f"
	obtains "nop_bij A (1\<^sub>\<nat>) f"
	using assms by blast

	lemma unop_bijI'[intro]:
	assumes "unop_v11 A f" and "A \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	shows "unop_bij A f"
	proof-
	interpret unop_v11 A f by (rule assms(1))
	from assms(2) nop_vrange have "A = \<R>\<^sub>\<circ> f" by simp
	with assms(1) show "unop_bij A f" by auto
	qed



	subsection\<open>Partial binary operation\<close>

	locale pbinop = pnop A \<open>2\<^sub>\<nat>\<close> f for A f

	sublocale pbinop \<subseteq> dom: fbrelation \<open>\<D>\<^sub>\<circ> f\<close>
	proof
	from pnop_vdomain show "fpairs (\<D>\<^sub>\<circ> f) = \<D>\<^sub>\<circ> f"
	by (intro vsubset_antisym vsubsetI) auto
	qed


	text\<open>Rules.\<close>

	lemmas pbinopI[intro] = pbinop.intro

	lemma pbinopD[dest]:
	assumes "pbinop A f"
	shows "pnop A (2\<^sub>\<nat>) f"
	using assms unfolding pbinop_def by auto

	lemma pbinopE[elim]:
	assumes "pbinop A f"
	obtains "pnop A (2\<^sub>\<nat>) f"
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma (in pbinop) fbinop_vcard:
	assumes "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	shows "vcard x = 2\<^sub>\<nat>"
	proof-
	from assms dom.fbrelation_axioms obtain a b where x_def: "x = [a, b]\<^sub>\<circ>" by blast
	show ?thesis by (auto simp: x_def nat_omega_simps)
	qed




	subsection\<open>Total binary operation\<close>

	locale binop = nop A \<open>2\<^sub>\<nat>\<close> f for A f

	sublocale binop \<subseteq> pbinop by unfold_locales


	text\<open>Rules.\<close>

	lemmas binopI[intro] = binop.intro

	lemma binopD[dest]:
	assumes "binop A f"
	shows "nop A (2\<^sub>\<nat>) f"
	using assms unfolding binop_def by auto

	lemma binopE[elim]:
	assumes "binop A f"
	obtains "nop A (2\<^sub>\<nat>) f"
	using assms by auto


	text\<open>Elementary properties.\<close>

	+lemma binop_eqI:
	+ assumes "binop A g"
	+ and "binop A f"
	+ and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> A; b \<in>\<^sub>\<circ> A \<rbrakk> \<Longrightarrow> g\<lparr>a, b\<rparr>\<^sub>\<bullet> = f\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	+ shows "g = f"
	+proof-
	+ interpret g: binop A g by (rule assms(1))
	+ interpret f: binop A f by (rule assms(2))
	+ show ?thesis
	+ proof
	+ (
	+ rule vsv_eqI;
	+ (intro g.vsv_axioms f.vsv_axioms)?;
	+ (unfold g.nop_vdomain f.nop_vdomain)
	+ )
	+ fix ab assume "ab \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
	+ then obtain a b where ab_def: "ab = [a, b]\<^sub>\<circ>"
	+ and a: "a \<in>\<^sub>\<circ> A"
	+ and b: "b \<in>\<^sub>\<circ> A"
	+ by auto
	+ show "g\<lparr>ab\<rparr> = f\<lparr>ab\<rparr>" unfolding ab_def by (rule assms(3)[OF a b])
	+ qed simp
	+qed
	+
	lemma (in binop) binop_app_in_vrange[intro]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "f\<lparr>a, b\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	proof-
	from assms have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>" by (auto simp: nat_omega_simps)
	then show ?thesis by (simp add: nop_vdomain vsv_vimageI2)
	qed



	subsection\<open>Injective binary operation\<close>

	locale binop_v11 = nop_v11 A \<open>2\<^sub>\<nat>\<close> f for A f

	sublocale binop_v11 \<subseteq> binop A f by (intro binopI) (simp add: nop_axioms)


	text\<open>Rules.\<close>

	lemma binop_v11I[intro]:
	assumes "nop_v11 A (2\<^sub>\<nat>) f"
	shows "binop_v11 A f"
	using assms by (rule binop_v11.intro)

	lemma binop_v11D[dest]:
	assumes "binop_v11 A f"
	shows "nop_v11 A (2\<^sub>\<nat>) f"
	using assms by (rule binop_v11.axioms)

	lemma binop_v11E[elim]:
	assumes "binop_v11 A f"
	obtains "nop_v11 A (2\<^sub>\<nat>) f"
	using assms by blast



	subsection\<open>Surjective binary operation\<close>

	locale binop_onto = nop_onto A \<open>2\<^sub>\<nat>\<close> f for A f

	sublocale binop_onto \<subseteq> binop A f by (intro binopI) (simp add: nop_axioms)


	text\<open>Rules.\<close>

	lemma binop_ontoI[intro]:
	assumes "nop_onto A (2\<^sub>\<nat>) f"
	shows "binop_onto A f"
	using assms by (rule binop_onto.intro)

	lemma binop_ontoD[dest]:
	assumes "binop_onto A f"
	shows "nop_onto A (2\<^sub>\<nat>) f"
	using assms by (rule binop_onto.axioms)

	lemma binop_ontoE[elim]:
	assumes "binop_onto A f"
	obtains "nop_onto A (2\<^sub>\<nat>) f"
	using assms by blast

	lemma binop_ontoI'[intro]:
	assumes "binop A f" and "A \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	shows "binop_onto A f"
	proof-
	interpret binop A f by (rule assms(1))
	from assms(2) nop_vrange have "A = \<R>\<^sub>\<circ> f" by simp
	with assms(1) show "binop_onto A f" by auto
	qed



	subsection\<open>Bijective binary operation\<close>

	locale binop_bij = nop_bij A \<open>2\<^sub>\<nat>\<close> f for A f

	sublocale binop_bij \<subseteq> binop_v11 A f
	by (intro binop_v11I) (simp add: nop_v11_axioms)

	sublocale binop_bij \<subseteq> binop_onto A f
	by (intro binop_ontoI) (simp add: nop_onto_axioms)


	text\<open>Rules.\<close>

	lemma binop_bijI[intro]:
	assumes "nop_bij A (2\<^sub>\<nat>) f"
	shows "binop_bij A f"
	using assms by (rule binop_bij.intro)

	lemma binop_bijD[dest]:
	assumes "binop_bij A f"
	shows "nop_bij A (2\<^sub>\<nat>) f"
	using assms by (rule binop_bij.axioms)

	lemma binop_bijE[elim]:
	assumes "binop_bij A f"
	obtains "nop_bij A (2\<^sub>\<nat>) f"
	using assms by blast

	lemma binop_bijI'[intro]:
	assumes "binop_v11 A f" and "A \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	shows "binop_bij A f"
	proof-
	interpret binop_v11 A f by (rule assms(1))
	from assms(2) nop_vrange have "A = \<R>\<^sub>\<circ> f" by simp
	with assms(1) show "binop_bij A f" by auto
	qed



	subsection\<open>Flip\<close>

	definition fflip :: "V \<Rightarrow> V"
	where "fflip f = (\<lambda>ab\<in>\<^sub>\<circ>(\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>. f\<lparr>ab\<lparr>1\<^sub>\<nat>\<rparr>, ab\<lparr>0\<rparr>\<rparr>\<^sub>\<bullet>)"


	text\<open>Elementary properties.\<close>

	lemma fflip_vempty[simp]: "fflip 0 = 0" unfolding fflip_def by auto

	lemma fflip_vsv: "vsv (fflip f)"
	by (intro vsvI) (auto simp: fflip_def)

	lemma vdomain_fflip[simp]: "\<D>\<^sub>\<circ> (fflip f) = (\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>"
	unfolding fflip_def by simp

	lemma (in pbinop) vrange_fflip: "\<R>\<^sub>\<circ> (fflip f) = \<R>\<^sub>\<circ> f"
	unfolding fflip_def
	proof(intro vsubset_antisym vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ((\<lambda>x\<in>\<^sub>\<circ>(\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>. f\<lparr>x\<lparr>1\<^sub>\<nat>\<rparr>, x\<lparr>0\<rparr>\<rparr>\<^sub>\<bullet>))"
	then obtain x where "x \<in>\<^sub>\<circ> (\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>" and y_def: "y = f\<lparr>x\<lparr>1\<^sub>\<nat>\<rparr>, x\<lparr>0\<rparr>\<rparr>\<^sub>\<bullet>" by fast
	then obtain a b where x_def: "x = [b, a]\<^sub>\<circ>" by clarsimp
	have y_def': "y = f\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	unfolding y_def x_def by (simp add: nat_omega_simps)
	from x_def \<open>x \<in>\<^sub>\<circ> (\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>\<close> have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f" by clarsimp
	then show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f" unfolding y_def' by (simp add: vsv_vimageI2)
	next
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	with vrange_atD obtain x where x: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f" and y_def: "y = f\<lparr>x\<rparr>" by blast
	with dom.fbrelation obtain a b where x_def: "x = [a, b]\<^sub>\<circ>" by blast
	from x have ba: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>" unfolding x_def by clarsimp
	then have y_def': "y = f\<lparr>[b, a]\<^sub>\<circ>\<lparr>1\<^sub>\<nat>\<rparr>, [b, a]\<^sub>\<circ>\<lparr>0\<rparr>\<rparr>\<^sub>\<bullet>"
	unfolding y_def x_def by (auto simp: nat_omega_simps)
	then show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ((\<lambda>ab\<in>\<^sub>\<circ>(\<D>\<^sub>\<circ> f)\<inverse>\<^sub>\<bullet>. f\<lparr>ab\<lparr>1\<^sub>\<nat>\<rparr>, ab\<lparr>0\<rparr>\<rparr>\<^sub>\<bullet>))"
	unfolding y_def'
	by (metis (lifting) ba beta rel_VLambda.vsv_vimageI2 vdomain_VLambda)
	qed

	lemma fflip_app[simp]:
	assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	shows "fflip f\<lparr>b, a\<rparr>\<^sub>\<bullet> = f\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	proof-
	from assms have "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (fflip f)" by clarsimp
	then show "fflip f\<lparr>b, a\<rparr>\<^sub>\<bullet> = f\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	by (simp add: fflip_def ord_of_nat_succ_vempty)
	qed

	lemma (in pbinop) pbinop_fflip_fflip: "fflip (fflip f) = f"
	proof(rule vsv_eqI)
	show "vsv (fflip (fflip f))" by (simp add: fflip_vsv)
	show "vsv f" by (rule vsv_axioms)
	show dom: "\<D>\<^sub>\<circ> (fflip (fflip f)) = \<D>\<^sub>\<circ> f" by simp
	fix x assume prems: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (fflip (fflip f))"
	with dom dom.fbrelation_axioms obtain a b where x_def: "x = [a, b]\<^sub>\<circ>" by auto
	from prems show "fflip (fflip f)\<lparr>x\<rparr> = f\<lparr>x\<rparr>"
	unfolding x_def by (auto simp: fconverseI)
	qed

	lemma (in binop) pbinop_fflip_app[simp]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "fflip f\<lparr>b, a\<rparr>\<^sub>\<bullet> = f\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	proof-
	from assms have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	unfolding nop_vdomain by (auto simp: nat_omega_simps)
	then show ?thesis by auto
	qed

	lemma fflip_vsingleton: "fflip (set {\<langle>[a, b]\<^sub>\<circ>, c\<rangle>}) = set {\<langle>[b, a]\<^sub>\<circ>, c\<rangle>}"
	proof-
	have dom_lhs: "\<D>\<^sub>\<circ> (fflip (set {\<langle>[a, b]\<^sub>\<circ>, c\<rangle>})) = set {[b, a]\<^sub>\<circ>}"
	unfolding fflip_def by auto
	have dom_rhs: "\<D>\<^sub>\<circ> (set {\<langle>[b, a]\<^sub>\<circ>, c\<rangle>}) = set {[b, a]\<^sub>\<circ>}" by simp
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix q assume "q \<in>\<^sub>\<circ> set {[b, a]\<^sub>\<circ>}"
	then have q_def: "q = [b, a]\<^sub>\<circ>" by simp
	show "fflip (set {\<langle>[a, b]\<^sub>\<circ>, c\<rangle>})\<lparr>q\<rparr> = set {\<langle>[b, a]\<^sub>\<circ>, c\<rangle>}\<lparr>q\<rparr>"
	unfolding q_def by auto
	qed (auto simp: fflip_def)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_Nat.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_Nat.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_Nat.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_Nat.thy
	@@ -1,244 +1,247 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Further properties of natural numbers\<close>
	theory CZH_Sets_Nat
	imports CZH_Sets_Sets
	begin



	subsection\<open>Background\<close>


	text\<open>
	The section exposes certain fundamental properties of natural numbers and
	provides convenience utilities for doing arithmetic within the type \<^typ>\<open>V\<close>.

	Many of the results that are presented in this sections were carried over
	(with amendments) from the theory \<open>Nat\<close> that can be found in the main
	library of Isabelle/HOL.
	\<close>

	notation ord_of_nat (\<open>_\<^sub>\<nat>\<close> [999] 999)

	named_theorems nat_omega_simps

	declare One_nat_def[simp del]

	abbreviation (input) vpfst where "vpfst a \<equiv> a\<lparr>0\<rparr>"
	abbreviation (input) vpsnd where "vpsnd a \<equiv> a\<lparr>1\<^sub>\<nat>\<rparr>"
	abbreviation (input) vpthrd where "vpthrd a \<equiv> a\<lparr>2\<^sub>\<nat>\<rparr>"



	subsection\<open>Conversion between \<^typ>\<open>V\<close> and \<open>nat\<close>\<close>


	subsubsection\<open>Primitive arithmetic\<close>

	lemma ord_of_nat_plus[nat_omega_simps]: "a\<^sub>\<nat> + b\<^sub>\<nat> = (a + b)\<^sub>\<nat>"
	by (induct b) (simp_all add: plus_V_succ_right)

	lemma ord_of_nat_times[nat_omega_simps]: "a\<^sub>\<nat> * b\<^sub>\<nat> = (a * b)\<^sub>\<nat>"
	by (induct b) (simp_all add: mult_succ nat_omega_simps)

	lemma ord_of_nat_succ[nat_omega_simps]: "succ (a\<^sub>\<nat>) = (Suc a)\<^sub>\<nat>" by auto

	lemmas [nat_omega_simps] = nat_cadd_eq_add

	lemma ord_of_nat_csucc[nat_omega_simps]: "csucc (a\<^sub>\<nat>) = succ (a\<^sub>\<nat>)"
	using finite_csucc by blast

	lemma ord_of_nat_succ_vempty[nat_omega_simps]: "succ 0 = 1\<^sub>\<nat>" by auto

	lemma ord_of_nat_vone[nat_omega_simps]: "1 = 1\<^sub>\<nat>" by auto


	subsubsection\<open>Transfer\<close>

	definition cr_omega :: "V \<Rightarrow> nat \<Rightarrow> bool"
	where "cr_omega a b \<longleftrightarrow> (a = ord_of_nat b)"


	text\<open>Transfer setup.\<close>

	lemma cr_omega_right_total[transfer_rule]: "right_total cr_omega"
	unfolding cr_omega_def right_total_def by simp

	lemma cr_omega_bi_unqie[transfer_rule]: "bi_unique cr_omega"
	unfolding cr_omega_def bi_unique_def
	by (simp add: inj_eq inj_ord_of_nat)

	lemma omega_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_omega = (\<lambda>x. x \<in>\<^sub>\<circ> \<omega>)"
	unfolding cr_omega_def by (auto simp: elts_\<omega>)

	lemma omega_transfer[transfer_rule]:
	"(rel_set cr_omega) (elts \<omega>) (UNIV::nat set)"
	unfolding cr_omega_def rel_set_def by (simp add: elts_\<omega>)

	lemma omega_of_real_transfer[transfer_rule]: "cr_omega (ord_of_nat a) a"
	unfolding cr_omega_def by auto


	text\<open>Operations.\<close>

	lemma omega_succ_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_omega ===> cr_omega) succ Suc"
	proof(intro rel_funI, unfold cr_omega_def)
	fix x y assume prems: "x = y\<^sub>\<nat>"
	show "succ x = Suc y\<^sub>\<nat>" unfolding prems ord_of_nat_succ[symmetric] ..
	qed

	lemma omega_plus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_omega ===> cr_omega ===> cr_omega) (+) (+)"
	by (intro rel_funI, unfold cr_omega_def) (simp add: nat_omega_simps)

	lemma omega_mult_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_omega ===> cr_omega ===> cr_omega) () ()"
	by (intro rel_funI, unfold cr_omega_def) (simp add: nat_omega_simps)

	lemma ord_of_nat_card_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(rel_set (=) ===> cr_omega) (\<lambda>x. ord_of_nat (card x)) card"
	by (intro rel_funI) (simp add: cr_omega_def rel_set_eq)

	+lemma ord_of_nat_transfer[transfer_rule]:
	+ "(rel_fun cr_omega (=)) id ord_of_nat"
	+ unfolding cr_omega_def by auto
	+


	subsection\<open>Elementary results\<close>

	lemma ord_of_nat_vempty: "0 = 0\<^sub>\<nat>" by auto

	lemma set_vzero_eq_ord_of_nat_vone: "set {0} = 1\<^sub>\<nat>"
	by (metis elts_1 set_of_elts ord_of_nat_vone)

	lemma vone_in_omega[simp]: "1 \<in>\<^sub>\<circ> \<omega>" unfolding \<omega>_def by force

	lemma nat_of_omega:
	assumes "n \<in>\<^sub>\<circ> \<omega>"
	obtains m where "n = m\<^sub>\<nat>"
	using assms unfolding \<omega>_def by clarsimp

	lemma omega_prev:
	assumes "n \<in>\<^sub>\<circ> \<omega>" and "0 \<in>\<^sub>\<circ> n"
	obtains k where "n = succ k"
	proof-
	from assms nat_of_omega obtain m where "n = m\<^sub>\<nat>" by auto
	with assms(2) obtain m' where "m = Suc m'"
	unfolding less_V_def by (auto dest: gr0_implies_Suc)
	with that show ?thesis unfolding \<open>n = m\<^sub>\<nat>\<close> using ord_of_nat.simps(2) by blast
	qed

	lemma omega_vplus_commutative:
	assumes "a \<in>\<^sub>\<circ> \<omega>" and "b \<in>\<^sub>\<circ> \<omega>"
	shows "a + b = b + a"
	using assms by (metis Groups.add_ac(2) nat_of_omega ord_of_nat_plus)

	lemma omega_vinetrsection[intro]:
	assumes "m \<in>\<^sub>\<circ> \<omega>" and "n \<in>\<^sub>\<circ> \<omega>"
	shows "m \<inter>\<^sub>\<circ> n \<in>\<^sub>\<circ> \<omega>"
	proof-
	from nat_into_Ord[OF assms(1)] nat_into_Ord[OF assms(2)] Ord_linear_le
	consider "m \<subseteq>\<^sub>\<circ> n" \| "n \<subseteq>\<^sub>\<circ> m"
	by auto
	then show ?thesis by cases (simp_all add: assms inf.absorb1 inf.absorb2)
	qed



	subsection\<open>Induction\<close>

	lemma omega_induct_all[consumes 1, case_names step]:
	assumes "n \<in>\<^sub>\<circ> \<omega>" and "\<And>x. \<lbrakk>x \<in>\<^sub>\<circ> \<omega>; \<And>y. y \<in>\<^sub>\<circ> x \<Longrightarrow> P y\<rbrakk> \<Longrightarrow> P x"
	shows "P n"
	using assms by (metis Ord_\<omega> Ord_induct Ord_linear Ord_trans nat_into_Ord)

	lemma omega_induct[consumes 1, case_names 0 succ]:
	assumes "n \<in>\<^sub>\<circ> \<omega>" and "P 0" and "\<And>n. \<lbrakk> n \<in>\<^sub>\<circ> \<omega>; P n \<rbrakk> \<Longrightarrow> P (succ n)"
	shows "P n"
	using assms(1,3)
	proof(induct rule: omega_induct_all)
	case (step x) show ?case
	proof(cases \<open>x = 0\<close>)
	case True with assms(2) show ?thesis by simp
	next
	case False
	with step(1) have "0 \<in>\<^sub>\<circ> x" by (simp add: mem_0_Ord)
	with \<open>x \<in>\<^sub>\<circ> \<omega>\<close> obtain y where x_def: "x = succ y" by (elim omega_prev)
	with elts_succ step.hyps(1) have "y \<in>\<^sub>\<circ> \<omega>" by (blast intro: Ord_trans)
	have "y \<in>\<^sub>\<circ> x" by (simp add: \<open>x = succ y\<close>)
	have "P y" by (auto intro: step.prems step.hyps(2)[OF \<open>y \<in>\<^sub>\<circ> x\<close>])
	from step.prems[OF \<open>y \<in>\<^sub>\<circ> \<omega>\<close> \<open>P y\<close>, folded x_def] show "P x" .
	qed
	qed



	subsection\<open>Methods\<close>


	text\<open>
	The following methods provide an infrastructure for working with goals of the
	form \<open>a \<in>\<^sub>\<circ> n\<^sub>\<nat> \<Longrightarrow> P a\<close>.
	\<close>

	lemma in_succE:
	assumes "a \<in>\<^sub>\<circ> succ n" and "\<And>a. a \<in>\<^sub>\<circ> n \<Longrightarrow> P a" and "P n"
	shows "P a"
	using assms by auto

	method Suc_of_numeral =
	(
	unfold numeral.simps add.assoc,
	use nothing in \<open>unfold Suc_eq_plus1_left[symmetric], unfold One_nat_def\<close>
	)

	method succ_of_numeral =
	(
	Suc_of_numeral,
	use nothing in \<open>unfold ord_of_nat_succ[symmetric] ord_of_nat_zero\<close>
	)

	method numeral_of_succ =
	(
	unfold nat_omega_simps,
	use nothing in
	\<open>
	unfold numeral.simps[symmetric] Suc_numeral add_num_simps,
	(unfold numerals(1))?
	\<close>
	)

	method elim_in_succ =
	(
	(
	elim in_succE;
	use nothing in \<open>(unfold triv_forall_equality)?; (numeral_of_succ)?\<close>
	),
	simp
	)

	method elim_in_numeral = (succ_of_numeral, use nothing in \<open>elim_in_succ\<close>)



	subsection\<open>Auxiliary\<close>

	lemma one: "1\<^sub>\<nat> = set {0}" by auto

	lemma two: "2\<^sub>\<nat> = set {0, 1\<^sub>\<nat>}" by force

	lemma three: "3\<^sub>\<nat> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" by force

	lemma four: "4\<^sub>\<nat> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>, 3\<^sub>\<nat>}" by force

	lemma two_vdiff_zero[simp]: "set {0, 1\<^sub>\<nat>} -\<^sub>\<circ> set {0} = set {1\<^sub>\<nat>}" by auto
	lemma two_vdiff_one[simp]: "set {0, 1\<^sub>\<nat>} -\<^sub>\<circ> set {1\<^sub>\<nat>} = set {0}" by auto

	-
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_Sets.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_Sets.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_Sets.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_Sets.thy
	@@ -1,1289 +1,1289 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Further set algebra and other miscellaneous results\<close>
	theory CZH_Sets_Sets
	imports CZH_Sets_Introduction
	begin



	subsection\<open>Background\<close>


	text\<open>
	This section presents further set algebra and various elementary properties
	of sets.

	Many of the results that are presented in this section
	were carried over (with amendments) from the theories \<^text>\<open>Set\<close>
	and \<^text>\<open>Complete_Lattices\<close> in the main library.
	\<close>

	declare elts_sup_iff[simp del]



	subsection\<open>Further notation\<close>


	subsubsection\<open>Set membership\<close>

	abbreviation vmember :: "V \<Rightarrow> V \<Rightarrow> bool" ("(_/ \<in>\<^sub>\<circ> _)" [51, 51] 50)
	where "vmember x A \<equiv> (x \<in> elts A)"
	notation vmember ("'(\<in>\<^sub>\<circ>')")
	and vmember ("(_/ \<in>\<^sub>\<circ> _)" [51, 51] 50)

	abbreviation not_vmember :: "V \<Rightarrow> V \<Rightarrow> bool" ("(_/ \<notin>\<^sub>\<circ> _)" [51, 51] 50)
	where "not_vmember x A \<equiv> (x \<notin> elts A)"
	notation
	not_vmember ("'(\<notin>\<^sub>\<circ>')") and
	not_vmember ("(_/ \<notin>\<^sub>\<circ> _)" [51, 51] 50)


	subsubsection\<open>Subsets\<close>

	abbreviation vsubset :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "vsubset \<equiv> less"
	abbreviation vsubset_eq :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "vsubset_eq \<equiv> less_eq"

	notation vsubset ("'(\<subset>\<^sub>\<circ>')")
	and vsubset ("(_/ \<subset>\<^sub>\<circ> _)" [51, 51] 50)
	and vsubset_eq ("'(\<subseteq>\<^sub>\<circ>')")
	and vsubset_eq ("(_/ \<subseteq>\<^sub>\<circ> _)" [51, 51] 50)


	subsubsection\<open>Ball\<close>

	syntax
	"_VBall" :: "pttrn \<Rightarrow> V \<Rightarrow> bool \<Rightarrow> bool" ("(3\<forall>(_/\<in>\<^sub>\<circ>_)./ _)" [0, 0, 10] 10)
	"_VBex" :: "pttrn \<Rightarrow> V \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>(_/\<in>\<^sub>\<circ>_)./ _)" [0, 0, 10] 10)
	"_VBex1" :: "pttrn \<Rightarrow> V \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>!(_/\<in>\<^sub>\<circ>_)./ _)" [0, 0, 10] 10)

	translations
	"\<forall>x\<in>\<^sub>\<circ>A. P" \<rightleftharpoons> "CONST Ball (CONST elts A) (\<lambda>x. P)"
	"\<exists>x\<in>\<^sub>\<circ>A. P" \<rightleftharpoons> "CONST Bex (CONST elts A) (\<lambda>x. P)"
	"\<exists>!x\<in>\<^sub>\<circ>A. P" \<rightharpoonup> "\<exists>!x. x \<in>\<^sub>\<circ> A \<and> P"


	subsubsection\<open>\<open>VLambda\<close>\<close>


	text\<open>The following notation was adapted from \cite{paulson_hereditarily_2013}.\<close>

	syntax "_vlam" :: "[pttrn, V, V] \<Rightarrow> V" (\<open>(3\<lambda>_\<in>\<^sub>\<circ>_./ _)\<close> 10)
	translations "\<lambda>x\<in>\<^sub>\<circ>A. f" \<rightleftharpoons> "CONST VLambda A (\<lambda>x. f)"


	subsubsection\<open>Intersection and union\<close>

	abbreviation vintersection :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<inter>\<^sub>\<circ>" 70)
	where "(\<inter>\<^sub>\<circ>) \<equiv> (\<sqinter>)"
	notation vintersection (infixl "\<inter>\<^sub>\<circ>" 70)

	abbreviation vunion :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<union>\<^sub>\<circ>" 65)
	where "vunion \<equiv> sup"
	notation vunion (infixl "\<union>\<^sub>\<circ>" 65)

	abbreviation VInter :: "V \<Rightarrow> V" (\<open>\<Inter>\<^sub>\<circ>\<close>)
	where "\<Inter>\<^sub>\<circ> A \<equiv> \<Sqinter> (elts A)"
	notation VInter (\<open>\<Inter>\<^sub>\<circ>\<close>)

	abbreviation VUnion :: "V \<Rightarrow> V" (\<open>\<Union>\<^sub>\<circ>\<close>)
	where "\<Union>\<^sub>\<circ>A \<equiv> \<Squnion> (elts A)"
	notation VUnion (\<open>\<Union>\<^sub>\<circ>\<close>)


	subsubsection\<open>Miscellaneous\<close>

	notation app (\<open>_\<lparr>_\<rparr>\<close> [999, 50] 999)
	notation vtimes (infixr "\<times>\<^sub>\<circ>" 80)



	subsection\<open>Elementary results.\<close>

	lemma vempty_nin[simp]: "a \<notin>\<^sub>\<circ> 0" by simp

	lemma vemptyE:
	assumes "A \<noteq> 0"
	obtains x where "x \<in>\<^sub>\<circ> A"
	using assms trad_foundation by auto

	lemma in_set_CollectI:
	assumes "P x" and "small {x. P x}"
	shows "x \<in>\<^sub>\<circ> set {x. P x}"
	using assms by simp

	lemma small_setcompr2:
	assumes "small {f x y \| x y. P x y}" and "a \<in>\<^sub>\<circ> set {f x y \| x y. P x y}"
	obtains x' y' where "a = f x' y'" and "P x' y'"
	using assms by auto

	lemma in_small_setI:
	assumes "small A" and "x \<in> A"
	shows "x \<in>\<^sub>\<circ> set A"
	using assms by simp

	lemma in_small_setD:
	assumes "x \<in>\<^sub>\<circ> set A" and "small A"
	shows "x \<in> A"
	using assms by simp

	lemma in_small_setE:
	assumes "a \<in>\<^sub>\<circ> set A" and "small A"
	obtains "a \<in> A"
	using assms by auto

	lemma small_set_vsubset:
	assumes "small A" and "A \<subseteq> elts B"
	shows "set A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma some_in_set_if_set_neq_vempty[simp]:
	assumes "A \<noteq> 0"
	shows "(SOME x. x \<in>\<^sub>\<circ> A) \<in>\<^sub>\<circ> A"
	by (meson assms someI_ex vemptyE)

	lemma small_vsubset_set[intro, simp]:
	assumes "small B" and "A \<subseteq> B"
	shows "set A \<subseteq>\<^sub>\<circ> set B"
	using assms by (auto simp: subset_iff_less_eq_V)

	lemma vset_neq_1:
	assumes "b \<notin>\<^sub>\<circ> A" and "a \<in>\<^sub>\<circ> A"
	shows "b \<noteq> a"
	using assms by auto

	lemma vset_neq_2:
	assumes "b \<in>\<^sub>\<circ> A" and "a \<notin>\<^sub>\<circ> A"
	shows "b \<noteq> a"
	using assms by auto

	lemma nin_vinsertI:
	assumes "a \<noteq> b" and "a \<notin>\<^sub>\<circ> A"
	shows "a \<notin>\<^sub>\<circ> vinsert b A"
	using assms by clarsimp

	lemma vsubset_if_subset:
	assumes "elts A \<subseteq> elts B"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma small_set_comprehension[simp]: "small {A i \| i. i \<in>\<^sub>\<circ> I}"
	proof(rule smaller_than_small)
	show "small (A ` elts I)" by auto
	qed auto



	subsection\<open>\<open>VBall\<close>\<close>

	lemma vball_cong:
	assumes "A = B" and "\<And>x. x \<in>\<^sub>\<circ> B \<Longrightarrow> P x \<longleftrightarrow> Q x"
	shows "(\<forall>x\<in>\<^sub>\<circ>A. P x) \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>B. Q x)"
	by (simp add: assms)

	lemma vball_cong_simp[cong]:
	assumes "A = B" and "\<And>x. x \<in>\<^sub>\<circ> B =simp=> P x \<longleftrightarrow> Q x "
	shows "(\<forall>x\<in>\<^sub>\<circ>A. P x) \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>B. Q x)"
	using assms by (simp add: simp_implies_def)



	subsection\<open>\<open>VBex\<close>\<close>

	lemma vbex_cong:
	assumes "A = B" and "\<And>x. x \<in>\<^sub>\<circ> B \<Longrightarrow> P x \<longleftrightarrow> Q x"
	shows "(\<exists>x\<in>\<^sub>\<circ>A. P x) \<longleftrightarrow> (\<exists>x\<in>\<^sub>\<circ>B. Q x)"
	using assms by (simp cong: conj_cong)

	lemma vbex_cong_simp[cong]:
	assumes "A = B" and "\<And>x. x \<in>\<^sub>\<circ> B =simp=> P x \<longleftrightarrow> Q x "
	shows "(\<exists>x\<in>\<^sub>\<circ>A. P x) \<longleftrightarrow> (\<exists>x\<in>\<^sub>\<circ>B. Q x)"
	using assms by (simp add: simp_implies_def)



	subsection\<open>Subset\<close>


	text\<open>Rules.\<close>

	lemma vsubset_antisym:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "B \<subseteq>\<^sub>\<circ> A"
	shows "A = B"
	using assms by simp

	lemma vsubsetI:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> B"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vpsubsetI:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "x \<notin>\<^sub>\<circ> A" and "x \<in>\<^sub>\<circ> B"
	shows "A \<subset>\<^sub>\<circ> B"
	using assms unfolding less_V_def by auto

	lemma vsubsetD:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> B"
	using assms by auto

	lemma vsubsetE:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "(\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> B) \<Longrightarrow> P"
	shows P
	using assms by auto

	lemma vpsubsetE:
	assumes "A \<subset>\<^sub>\<circ> B"
	obtains x where "A \<subseteq>\<^sub>\<circ> B" and "x \<notin>\<^sub>\<circ> A" and "x \<in>\<^sub>\<circ> B"
	using assms unfolding less_V_def by (meson V_equalityI vsubsetE)

	lemma vsubset_iff: "A \<subseteq>\<^sub>\<circ> B \<longleftrightarrow> (\<forall>t. t \<in>\<^sub>\<circ> A \<longrightarrow> t \<in>\<^sub>\<circ> B)" by blast


	text\<open>Elementary properties.\<close>

	lemma vsubset_eq: "A \<subseteq>\<^sub>\<circ> B \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>A. x \<in>\<^sub>\<circ> B)" by auto

	lemma vsubset_transitive[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "B \<subseteq>\<^sub>\<circ> C"
	shows "A \<subseteq>\<^sub>\<circ> C"
	using assms by simp

	lemma vsubset_reflexive: "A \<subseteq>\<^sub>\<circ> A" by simp


	text\<open>Set operations.\<close>

	lemma vsubset_vempty: "0 \<subseteq>\<^sub>\<circ> A" by simp

	lemma vsubset_vsingleton_left: "set {a} \<subseteq>\<^sub>\<circ> A \<longleftrightarrow> a \<in>\<^sub>\<circ> A" by auto

	lemmas vsubset_vsingleton_leftD[dest] = vsubset_vsingleton_left[THEN iffD1]
	and vsubset_vsingleton_leftI[intro] = vsubset_vsingleton_left[THEN iffD2]

	lemma vsubset_vsingleton_right: "A \<subseteq>\<^sub>\<circ> set {a} \<longleftrightarrow> A = set {a} \<or> A = 0"
	by (auto intro!: vsubset_antisym)

	lemmas vsubset_vsingleton_rightD[dest] = vsubset_vsingleton_right[THEN iffD1]
	and vsubset_vsingleton_rightI[intro] = vsubset_vsingleton_right[THEN iffD2]

	lemma vsubset_vdoubleton_leftD[dest]:
	assumes "set {a, b} \<subseteq>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	using assms by auto

	lemma vsubset_vdoubleton_leftI[intro]:
	assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> A"
	shows "set {a, b} \<subseteq>\<^sub>\<circ> A"
	using assms by auto

	lemma vsubset_vinsert_leftD[dest]:
	assumes "vinsert a A \<subseteq>\<^sub>\<circ> B"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vsubset_vinsert_leftI[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "a \<in>\<^sub>\<circ> B"
	shows "vinsert a A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vsubset_vinsert_vinsertI[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> vinsert b B"
	shows "vinsert b A \<subseteq>\<^sub>\<circ> vinsert b B"
	using assms by auto

	lemma vsubset_vinsert_rightI[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "A \<subseteq>\<^sub>\<circ> vinsert b B"
	using assms by auto

	lemmas vsubset_VPow = VPow_le_VPow_iff

	lemmas vsubset_VPowD = vsubset_VPow[THEN iffD1]
	and vsubset_VPowI = vsubset_VPow[THEN iffD2]


	text\<open>Special properties.\<close>

	lemma vsubset_contraD:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "c \<notin>\<^sub>\<circ> B"
	shows "c \<notin>\<^sub>\<circ> A"
	using assms by auto



	subsection\<open>Equality\<close>


	text\<open>Rules.\<close>

	lemma vequalityD1:
	assumes "A = B"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by simp

	lemma vequalityD2:
	assumes "A = B"
	shows "B \<subseteq>\<^sub>\<circ> A"
	using assms by simp

	lemma vequalityE:
	assumes "A = B" and "\<lbrakk> A \<subseteq>\<^sub>\<circ> B; B \<subseteq>\<^sub>\<circ> A \<rbrakk> \<Longrightarrow> P"
	shows P
	using assms by simp

	lemma vequalityCE[elim]:
	assumes "A = B" and "\<lbrakk> c \<in>\<^sub>\<circ> A; c \<in>\<^sub>\<circ> B \<rbrakk> \<Longrightarrow> P" and "\<lbrakk> c \<notin>\<^sub>\<circ> A; c \<notin>\<^sub>\<circ> B \<rbrakk> \<Longrightarrow> P"
	shows P
	using assms by auto



	subsection\<open>Binary intersection\<close>

	lemma vintersection_def: "A \<inter>\<^sub>\<circ> B = set {x. x \<in>\<^sub>\<circ> A \<and> x \<in>\<^sub>\<circ> B}"
	by (metis Int_def inf_V_def)

	lemma small_vintersection_set[simp]: "small {x. x \<in>\<^sub>\<circ> A \<and> x \<in>\<^sub>\<circ> B}"
	by (rule down[of _ A]) auto


	text\<open>Rules.\<close>

	lemma vintersection_iff[simp]: "x \<in>\<^sub>\<circ> A \<inter>\<^sub>\<circ> B \<longleftrightarrow> x \<in>\<^sub>\<circ> A \<and> x \<in>\<^sub>\<circ> B"
	unfolding vintersection_def by simp

	lemma vintersectionI[intro!]:
	assumes "x \<in>\<^sub>\<circ> A" and "x \<in>\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> A \<inter>\<^sub>\<circ> B"
	using assms by simp

	lemma vintersectionD1[dest]:
	assumes "x \<in>\<^sub>\<circ> A \<inter>\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> A"
	using assms by simp

	lemma vintersectionD2[dest]:
	assumes "x \<in>\<^sub>\<circ> A \<inter>\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> B"
	using assms by simp

	lemma vintersectionE[elim!]:
	assumes "x \<in>\<^sub>\<circ> A \<inter>\<^sub>\<circ> B" and "x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> B \<Longrightarrow> P"
	shows P
	using assms by simp


	text\<open>Elementary properties.\<close>

	lemma vintersection_intersection: "A \<inter>\<^sub>\<circ> B = set (elts A \<inter> elts B)"
	unfolding inf_V_def by simp

	lemma vintersection_assoc: "A \<inter>\<^sub>\<circ> (B \<inter>\<^sub>\<circ> C) = (A \<inter>\<^sub>\<circ> B) \<inter>\<^sub>\<circ> C" by auto

	-lemma vintersection_commutativity: "A \<inter>\<^sub>\<circ> B = B \<inter>\<^sub>\<circ> A" by auto
	+lemma vintersection_commute: "A \<inter>\<^sub>\<circ> B = B \<inter>\<^sub>\<circ> A" by auto


	text\<open>Previous set operations.\<close>

	lemma vsubset_vintersection_right: "A \<subseteq>\<^sub>\<circ> (B \<inter>\<^sub>\<circ> C) = (A \<subseteq>\<^sub>\<circ> B \<and> A \<subseteq>\<^sub>\<circ> C)"
	by clarsimp

	lemma vsubset_vintersection_rightD[dest]:
	assumes "A \<subseteq>\<^sub>\<circ> (B \<inter>\<^sub>\<circ> C)"
	shows "A \<subseteq>\<^sub>\<circ> B" and "A \<subseteq>\<^sub>\<circ> C"
	using assms by auto

	lemma vsubset_vintersection_rightI[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "A \<subseteq>\<^sub>\<circ> C"
	shows "A \<subseteq>\<^sub>\<circ> (B \<inter>\<^sub>\<circ> C)"
	using assms by auto


	text\<open>Set operations.\<close>

	lemma vintersection_vempty: "0 \<subseteq>\<^sub>\<circ> A" by simp

	lemma vintersection_vsingleton: "a \<in>\<^sub>\<circ> set {a}" by simp

	lemma vintersection_vdoubleton: "a \<in>\<^sub>\<circ> set {a, b}" and "b \<in>\<^sub>\<circ> set {a, b}"
	by simp_all

	lemma vintersection_VPow[simp]: "VPow (A \<inter>\<^sub>\<circ> B) = VPow A \<inter>\<^sub>\<circ> VPow B" by auto


	text\<open>Special properties.\<close>

	lemma vintersection_function_mono:
	assumes "mono f"
	shows "f (A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> f A \<inter>\<^sub>\<circ> f B"
	using assms by (fact mono_inf)



	subsection\<open>Binary union\<close>

	lemma small_vunion_set: "small {x. x \<in>\<^sub>\<circ> A \<or> x \<in>\<^sub>\<circ> B}"
	by (rule down[of _ \<open>A \<union>\<^sub>\<circ> B\<close>]) (auto simp: elts_sup_iff)


	text\<open>Rules.\<close>

	lemma vunion_def: "A \<union>\<^sub>\<circ> B = set {x. x \<in>\<^sub>\<circ> A \<or> x \<in>\<^sub>\<circ> B}"
	unfolding Un_def sup_V_def by simp

	lemma vunion_iff[simp]: "x \<in>\<^sub>\<circ> A \<union>\<^sub>\<circ> B \<longleftrightarrow> x \<in>\<^sub>\<circ> A \<or> x \<in>\<^sub>\<circ> B"
	by (simp add: elts_sup_iff)

	lemma vunionI1:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> A \<union>\<^sub>\<circ> B"
	using assms by simp

	lemma vunionI2:
	assumes "a \<in>\<^sub>\<circ> B"
	shows "a \<in>\<^sub>\<circ> A \<union>\<^sub>\<circ> B"
	using assms by simp

	lemma vunionCI[intro!]:
	assumes "x \<notin>\<^sub>\<circ> B \<Longrightarrow> x \<in>\<^sub>\<circ> A"
	shows "x \<in>\<^sub>\<circ> A \<union>\<^sub>\<circ> B"
	using assms by clarsimp

	lemma vunionE[elim!]:
	assumes "x \<in>\<^sub>\<circ> A \<union>\<^sub>\<circ> B" and "x \<in>\<^sub>\<circ> A \<Longrightarrow> P" and "x \<in>\<^sub>\<circ> B \<Longrightarrow> P"
	shows P
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma vunion_union: "A \<union>\<^sub>\<circ> B = set (elts A \<union> elts B)" by auto

	lemma vunion_assoc: "A \<union>\<^sub>\<circ> (B \<union>\<^sub>\<circ> C) = (A \<union>\<^sub>\<circ> B) \<union>\<^sub>\<circ> C" by auto

	-lemma vunion_comm: "A \<union>\<^sub>\<circ> B = B \<union>\<^sub>\<circ> A" by auto
	+lemma vunion_commute: "A \<union>\<^sub>\<circ> B = B \<union>\<^sub>\<circ> A" by auto


	text\<open>Previous set operations.\<close>

	lemma vsubset_vunion_left: "(A \<union>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> C \<longleftrightarrow> (A \<subseteq>\<^sub>\<circ> C \<and> B \<subseteq>\<^sub>\<circ> C)" by simp

	lemma vsubset_vunion_leftD[dest]:
	assumes "(A \<union>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> C"
	shows "A \<subseteq>\<^sub>\<circ> C" and "B \<subseteq>\<^sub>\<circ> C"
	using assms by auto

	lemma vsubset_vunion_leftI[intro]:
	assumes "A \<subseteq>\<^sub>\<circ> C" and "B \<subseteq>\<^sub>\<circ> C"
	shows "(A \<union>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> C"
	using assms by auto

	lemma vintersection_vunion_left: "(A \<union>\<^sub>\<circ> B) \<inter>\<^sub>\<circ> C = (A \<inter>\<^sub>\<circ> C) \<union>\<^sub>\<circ> (B \<inter>\<^sub>\<circ> C)"
	by auto

	lemma vintersection_vunion_right: "A \<inter>\<^sub>\<circ> (B \<union>\<^sub>\<circ> C) = (A \<inter>\<^sub>\<circ> B) \<union>\<^sub>\<circ> (A \<inter>\<^sub>\<circ> C)"
	by auto


	text\<open>Set operations.\<close>

	lemmas vunion_vempty_left = sup_V_0_left
	and vunion_vempty_right = sup_V_0_right

	lemma vunion_vsingleton[simp]: "set {a} \<union>\<^sub>\<circ> A = vinsert a A" by auto

	lemma vunion_vdoubleton[simp]: "set {a, b} \<union>\<^sub>\<circ> A = vinsert a (vinsert b A)"
	by auto

	-lemma vunion_vinsert_commutativity_left:
	+lemma vunion_vinsert_comm_left:
	"(vinsert a A) \<union>\<^sub>\<circ> B = A \<union>\<^sub>\<circ> (vinsert a B)"
	by auto

	-lemma vunion_vinsert_commutativity_right:
	+lemma vunion_vinsert_comm_right:
	"A \<union>\<^sub>\<circ> (vinsert a B) = (vinsert a A) \<union>\<^sub>\<circ> B"
	by auto

	lemma vinsert_def: "vinsert y B = set {x. x = y} \<union>\<^sub>\<circ> B" by auto

	lemma vunion_vinsert_left: "(vinsert a A) \<union>\<^sub>\<circ> B = vinsert a (A \<union>\<^sub>\<circ> B)" by auto

	lemma vunion_vinsert_right: "A \<union>\<^sub>\<circ> (vinsert a B) = vinsert a (A \<union>\<^sub>\<circ> B)" by auto


	text\<open>Special properties.\<close>

	lemma vunion_fun_mono:
	assumes "mono f"
	shows "f A \<union>\<^sub>\<circ> f B \<subseteq>\<^sub>\<circ> f (A \<union>\<^sub>\<circ> B)"
	using assms by (fact mono_sup)



	subsection\<open>Set difference\<close>

	definition vdiff :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>-\<^sub>\<circ>\<close> 65)
	where "A -\<^sub>\<circ> B = set {x. x \<in>\<^sub>\<circ> A \<and> x \<notin>\<^sub>\<circ> B}"
	notation vdiff (infixl "-\<^sub>\<circ>" 65)

	lemma small_set_vdiff[simp]: "small {x. x \<in>\<^sub>\<circ> A \<and> x \<notin>\<^sub>\<circ> B}"
	by (rule down[of _ A]) simp


	text\<open>Rules.\<close>

	lemma vdiff_iff[simp]: "x \<in>\<^sub>\<circ> A -\<^sub>\<circ> B \<longleftrightarrow> x \<in>\<^sub>\<circ> A \<and> x \<notin>\<^sub>\<circ> B"
	unfolding vdiff_def by simp

	lemma vdiffI[intro!]:
	assumes "x \<in>\<^sub>\<circ> A" and "x \<notin>\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> A -\<^sub>\<circ> B"
	using assms by simp

	lemma vdiffD1:
	assumes "x \<in>\<^sub>\<circ> A -\<^sub>\<circ> B"
	shows "x \<in>\<^sub>\<circ> A"
	using assms by simp

	lemma vdiffD2:
	assumes "x \<in>\<^sub>\<circ> A -\<^sub>\<circ> B" and "x \<in>\<^sub>\<circ> B"
	shows P
	using assms by simp

	lemma vdiffE[elim!]:
	assumes "x \<in>\<^sub>\<circ> A -\<^sub>\<circ> B" and "\<lbrakk> x \<in>\<^sub>\<circ> A; x \<notin>\<^sub>\<circ> B \<rbrakk> \<Longrightarrow> P"
	shows P
	using assms by simp


	text\<open>Previous set operations.\<close>

	lemma vsubset_vdiff:
	assumes "A \<subseteq>\<^sub>\<circ> B -\<^sub>\<circ> C"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma vinsert_vdiff_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> B"
	shows "vinsert a (A -\<^sub>\<circ> B) = vinsert a A -\<^sub>\<circ> B"
	using assms by auto


	text\<open>Set operations.\<close>

	lemma vdiff_vempty_left[simp]: "0 -\<^sub>\<circ> A = 0" by auto

	lemma vdiff_vempty_right[simp]: "A -\<^sub>\<circ> 0 = A" by auto

	lemma vdiff_vsingleton_vinsert[simp]: "set {a} -\<^sub>\<circ> vinsert a A = 0" by auto

	lemma vdiff_vsingleton_in[simp]:
	assumes "a \<in>\<^sub>\<circ> A"
	shows "set {a} -\<^sub>\<circ> A = 0"
	using assms by auto

	lemma vdiff_vsingleton_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "set {a} -\<^sub>\<circ> A = set {a}"
	using assms by auto

	lemma vdiff_vinsert_vsingleton[simp]: "vinsert a A -\<^sub>\<circ> set {a} = A -\<^sub>\<circ> set {a}"
	by auto

	lemma vdiff_vsingleton[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "A -\<^sub>\<circ> set {a} = A"
	using assms by auto

	lemma vdiff_vsubset:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "D \<subseteq>\<^sub>\<circ> C"
	shows "A -\<^sub>\<circ> C \<subseteq>\<^sub>\<circ> B -\<^sub>\<circ> D"
	using assms by auto

	lemma vdiff_vinsert_left_in[simp]:
	assumes "a \<in>\<^sub>\<circ> B"
	shows "(vinsert a A) -\<^sub>\<circ> B = A -\<^sub>\<circ> B"
	using assms by auto

	lemma vdiff_vinsert_left_nin:
	assumes "a \<notin>\<^sub>\<circ> B"
	shows "(vinsert a A) -\<^sub>\<circ> B = vinsert a (A -\<^sub>\<circ> B)"
	using assms by auto

	lemma vdiff_vinsert_right_in: "A -\<^sub>\<circ> (vinsert a B) = A -\<^sub>\<circ> B -\<^sub>\<circ> set {a}" by auto

	lemma vdiff_vinsert_right_nin[simp]:
	assumes "a \<notin>\<^sub>\<circ> A"
	shows "A -\<^sub>\<circ> (vinsert a B) = A -\<^sub>\<circ> B"
	using assms by auto

	lemma vdiff_vintersection_left: "(A \<inter>\<^sub>\<circ> B) -\<^sub>\<circ> C = (A -\<^sub>\<circ> C) \<inter>\<^sub>\<circ> (B -\<^sub>\<circ> C)" by auto

	lemma vdiff_vunion_left: "(A \<union>\<^sub>\<circ> B) -\<^sub>\<circ> C = (A -\<^sub>\<circ> C) \<union>\<^sub>\<circ> (B -\<^sub>\<circ> C)" by auto


	text\<open>Special properties.\<close>

	lemma complement_vsubset: "I -\<^sub>\<circ> J \<subseteq>\<^sub>\<circ> I" by auto

	lemma vintersection_complement: "(I -\<^sub>\<circ> J) \<inter>\<^sub>\<circ> J = 0" by auto

	lemma vunion_complement:
	assumes "J \<subseteq>\<^sub>\<circ> I"
	shows "I -\<^sub>\<circ> J \<union>\<^sub>\<circ> J = I"
	using assms by auto


	subsection\<open>Augmenting a set with an element\<close>

	lemma vinsert_compr: "vinsert y A = set {x. x = y \<or> x \<in>\<^sub>\<circ> A}"
	unfolding vunion_def vinsert_def by simp_all


	text\<open>Rules.\<close>

	lemma vinsert_iff[simp]: "x \<in>\<^sub>\<circ> vinsert y A \<longleftrightarrow> x = y \<or> x \<in>\<^sub>\<circ> A" by simp

	lemma vinsertI1: "x \<in>\<^sub>\<circ> vinsert x A" by simp

	lemma vinsertI2:
	assumes "x \<in>\<^sub>\<circ> A"
	shows "x \<in>\<^sub>\<circ> vinsert y A"
	using assms by simp

	lemma vinsertE1[elim!]:
	assumes "x \<in>\<^sub>\<circ> vinsert y A" and "x = y \<Longrightarrow> P" and "x \<in>\<^sub>\<circ> A \<Longrightarrow> P"
	shows P
	using assms unfolding vinsert_def by auto

	lemma vinsertCI[intro!]:
	assumes "x \<notin>\<^sub>\<circ> A \<Longrightarrow> x = y"
	shows "x \<in>\<^sub>\<circ> vinsert y A"
	using assms by clarsimp


	text\<open>Elementary properties.\<close>

	lemma vinsert_insert: "vinsert a A = set (insert a (elts A))" by auto

	-lemma vinsert_commutativity: "vinsert a (vinsert b C) = vinsert b (vinsert a C)"
	+lemma vinsert_commute: "vinsert a (vinsert b C) = vinsert b (vinsert a C)"
	by auto

	lemma vinsert_ident:
	assumes "x \<notin>\<^sub>\<circ> A" and "x \<notin>\<^sub>\<circ> B"
	shows "vinsert x A = vinsert x B \<longleftrightarrow> A = B"
	using assms by force

	lemmas vinsert_identD[dest] = vinsert_ident[THEN iffD1, rotated 2]
	and vinsert_identI[intro] = vinsert_ident[THEN iffD2]


	text\<open>Set operations.\<close>

	lemma vinsert_vempty: "vinsert a 0 = set {a}" by auto

	lemma vinsert_vsingleton: "vinsert a (set {b}) = set {a, b}" by auto

	lemma vinsert_vdoubleton: "vinsert a (set {b, c}) = set {a, b, c}" by auto

	lemma vinsert_vinsert: "vinsert a (vinsert b C) = set {a, b} \<union>\<^sub>\<circ> C" by auto

	lemma vinsert_vunion_left: "vinsert a (A \<union>\<^sub>\<circ> B) = vinsert a A \<union>\<^sub>\<circ> B" by auto

	lemma vinsert_vunion_right: "vinsert a (A \<union>\<^sub>\<circ> B) = A \<union>\<^sub>\<circ> vinsert a B" by auto

	lemma vinsert_vintersection: "vinsert a (A \<inter>\<^sub>\<circ> B) = vinsert a A \<inter>\<^sub>\<circ> vinsert a B"
	by auto


	text\<open>Special properties.\<close>

	lemma vinsert_set_insert_empty_anyI:
	assumes "P (vinsert a 0)"
	shows "P (set (insert a {}))"
	using assms by (simp add: vinsert_def)

	lemma vinsert_set_insert_anyI:
	assumes "small B" and "P (vinsert a (set (insert b B)))"
	shows "P (set (insert a (insert b B)))"
	using assms by (simp add: ZFC_in_HOL.vinsert_def)

	lemma vinsert_set_insert_eq:
	assumes "small B"
	shows "set (insert a (insert b B)) = vinsert a (set (insert b B))"
	using assms by (simp add: ZFC_in_HOL.vinsert_def)

	lemma vsubset_vinsert:
	"A \<subseteq>\<^sub>\<circ> vinsert x B \<longleftrightarrow> (if x \<in>\<^sub>\<circ> A then A -\<^sub>\<circ> set {x} \<subseteq>\<^sub>\<circ> B else A \<subseteq>\<^sub>\<circ> B)"
	by auto

	lemma vinsert_obtain_ne:
	assumes "A \<noteq> 0"
	obtains a A' where "A = vinsert a A'" and "a \<notin>\<^sub>\<circ> A'"
	proof-
	from assms mem_not_refl obtain a where "a \<in>\<^sub>\<circ> A"
	by (auto intro!: vsubset_antisym)
	with \<open>a \<in>\<^sub>\<circ> A\<close> have "A = vinsert a (A -\<^sub>\<circ> set {a})" by auto
	then show ?thesis using that by auto
	qed



	subsection\<open>Power set\<close>


	text\<open>Rules.\<close>

	lemma VPowI:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "A \<in>\<^sub>\<circ> VPow B"
	using assms by simp

	lemma VPowD:
	assumes "A \<in>\<^sub>\<circ> VPow B"
	shows "A \<subseteq>\<^sub>\<circ> B"
	using assms by (simp add: Pow_def)

	lemma VPowE[elim]:
	assumes "A \<in>\<^sub>\<circ> VPow B" and "A \<subseteq>\<^sub>\<circ> B \<Longrightarrow> P"
	shows P
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma VPow_bottom: "0 \<in>\<^sub>\<circ> VPow B" by simp

	lemma VPow_top: "A \<in>\<^sub>\<circ> VPow A" by simp


	text\<open>Set operations.\<close>

	lemma VPow_vempty[simp]: "VPow 0 = set {0}" by auto

	lemma VPow_vsingleton[simp]: "VPow (set {a}) = set {0, set {a}}"
	by (rule vsubset_antisym; rule vsubsetI) auto

	lemma VPow_not_vempty: "VPow A \<noteq> 0" by auto

	lemma VPow_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "VPow A \<subseteq>\<^sub>\<circ> VPow B"
	using assms by simp

	lemma VPow_vunion_subset: "VPow A \<union>\<^sub>\<circ> VPow B \<subseteq>\<^sub>\<circ> VPow (A \<union>\<^sub>\<circ> B)" by simp



	subsection\<open>Singletons, using insert\<close>


	text\<open>Rules.\<close>

	lemma vsingletonI[intro!]: "x \<in>\<^sub>\<circ> set {x}" by auto

	lemma vsingletonD[dest!]:
	assumes "y \<in>\<^sub>\<circ> set {x}"
	shows "y = x"
	using assms by auto

	lemma vsingleton_iff: "y \<in>\<^sub>\<circ> set {x} \<longleftrightarrow> y = x" by simp


	text\<open>Previous set operations.\<close>

	lemma VPow_vdoubleton[simp]:
	"VPow (set {a, b}) = set {0, set {a}, set {b}, set {a, b}}"
	by (intro vsubset_antisym vsubsetI)
	(auto intro!: vsubset_antisym simp: vinsert_set_insert_eq)

	lemma vsubset_vinsertI:
	assumes "A -\<^sub>\<circ> set {x} \<subseteq>\<^sub>\<circ> B"
	shows "A \<subseteq>\<^sub>\<circ> vinsert x B"
	using assms by auto


	text\<open>Special properties.\<close>

	lemma vsingleton_inject:
	assumes "set {x} = set {y}"
	shows "x = y"
	using assms by simp

	lemma vsingleton_insert_inj_eq[iff]:
	"set {y} = vinsert x A \<longleftrightarrow> x = y \<and> A \<subseteq>\<^sub>\<circ> set {y}"
	by auto

	lemma vsingleton_insert_inj_eq'[iff]:
	"vinsert x A = set {y} \<longleftrightarrow> x = y \<and> A \<subseteq>\<^sub>\<circ> set {y}"
	by auto

	lemma vsubset_vsingletonD:
	assumes "A \<subseteq>\<^sub>\<circ> set {x}"
	shows "A = 0 \<or> A = set {x}"
	using assms by auto

	lemma vsubset_vsingleton_iff: "a \<subseteq>\<^sub>\<circ> set {x} \<longleftrightarrow> a = 0 \<or> a = set {x}" by auto

	lemma vsubset_vdiff_vinsert: "A \<subseteq>\<^sub>\<circ> B -\<^sub>\<circ> vinsert x C \<longleftrightarrow> A \<subseteq>\<^sub>\<circ> B -\<^sub>\<circ> C \<and> x \<notin>\<^sub>\<circ> A"
	by auto

	lemma vunion_vsingleton_iff:
	"A \<union>\<^sub>\<circ> B = set {x} \<longleftrightarrow>
	A = 0 \<and> B = set {x} \<or> A = set {x} \<and> B = 0 \<or> A = set {x} \<and> B = set {x}"
	by
	(
	metis
	vsubset_vsingletonD inf_sup_ord(4) sup.idem sup_V_0_right sup_commute
	)

	lemma vsingleton_Un_iff:
	"set {x} = A \<union>\<^sub>\<circ> B \<longleftrightarrow>
	A = 0 \<and> B = set {x} \<or> A = set {x} \<and> B = 0 \<or> A = set {x} \<and> B = set {x}"
	by (metis vunion_vsingleton_iff sup_V_0_left sup_V_0_right sup_idem)

	lemma VPow_vsingleton_iff[simp]: "VPow X = set {Y} \<longleftrightarrow> X = 0 \<and> Y = 0"
	by (auto intro!: vsubset_antisym)



	subsection\<open>Intersection of elements\<close>

	lemma small_VInter[simp]:
	assumes "A \<noteq> 0"
	shows "small {a. \<forall>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}"
	by (metis (no_types, lifting) assms down eq0_iff mem_Collect_eq subsetI)

	lemma VInter_def: "\<Inter>\<^sub>\<circ> A = (if A = 0 then 0 else set {a. \<forall>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x})"
	proof(cases \<open>A = 0\<close>)
	case True show ?thesis unfolding True Inf_V_def by simp
	next
	case False
	from False have "(\<Inter> (elts ` elts A)) = {a. \<forall>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}" by auto
	with False show ?thesis unfolding Inf_V_def by auto
	qed


	text\<open>Rules.\<close>

	lemma VInter_iff[simp]:
	assumes [simp]: "A \<noteq> 0"
	shows "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>A. a \<in>\<^sub>\<circ> x)"
	unfolding VInter_def by auto

	lemma VInterI[intro]:
	assumes "A \<noteq> 0" and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> a \<in>\<^sub>\<circ> x"
	shows "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A"
	using assms by auto

	lemma VInter0I[intro]:
	assumes "A = 0"
	shows "\<Inter>\<^sub>\<circ> A = 0"
	using assms unfolding VInter_def by simp

	lemma VInterD[dest]:
	assumes "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A" and "x \<in>\<^sub>\<circ> A"
	shows "a \<in>\<^sub>\<circ> x"
	using assms by (cases \<open>A = 0\<close>) auto

	lemma VInterE1[elim]:
	assumes "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A" and "x \<notin>\<^sub>\<circ> A \<Longrightarrow> R" and "a \<in>\<^sub>\<circ> x \<Longrightarrow> R"
	shows R
	using assms elts_0 unfolding Inter_eq by blast

	lemma VInterE2[elim]:
	assumes "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A"
	obtains x where "a \<in>\<^sub>\<circ> x" and "x \<in>\<^sub>\<circ> A"
	proof(cases \<open>A = 0\<close>)
	show "(\<And>x. a \<in>\<^sub>\<circ> x \<Longrightarrow> x \<in>\<^sub>\<circ> A \<Longrightarrow> thesis) \<Longrightarrow> A = 0 \<Longrightarrow> thesis"
	using assms unfolding Inf_V_def by auto
	show "(\<And>x. a \<in>\<^sub>\<circ> x \<Longrightarrow> x \<in>\<^sub>\<circ> A \<Longrightarrow> thesis) \<Longrightarrow> A \<noteq> 0 \<Longrightarrow> thesis"
	using assms by (meson assms VInterE1 that trad_foundation)
	qed

	lemma VInterE3: (not elim)
	assumes "a \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A" and "(\<And>y. y \<in>\<^sub>\<circ> A \<Longrightarrow> a \<in>\<^sub>\<circ> y) \<Longrightarrow> P"
	shows P
	using assms by auto


	text\<open>Elementary properties.\<close>

	lemma VInter_Inter: "\<Inter>\<^sub>\<circ> A = set (\<Inter> (elts ` (elts A)))"
	by (simp add: Inf_V_def ext)

	lemma VInter_eq:
	assumes [simp]: "A \<noteq> 0"
	shows "\<Inter>\<^sub>\<circ> A = set {a. \<forall>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}"
	unfolding VInter_def by auto


	text\<open>Set operations.\<close>

	lemma VInter_vempty[simp]: "\<Inter>\<^sub>\<circ> 0 = 0" using VInter0I by auto

	lemma VInf_vempty[simp]: "\<Sqinter>{} = (0::V)" by (simp add: Inf_V_def)

	lemma VInter_vdoubleton: "\<Inter>\<^sub>\<circ> (set {a, b}) = a \<inter>\<^sub>\<circ> b"
	proof(intro vsubset_antisym vsubsetI)
	show "x \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> (set {a, b}) \<Longrightarrow> x \<in>\<^sub>\<circ> a \<inter>\<^sub>\<circ> b" for x by (elim VInterE3) auto
	show "x \<in>\<^sub>\<circ> a \<inter>\<^sub>\<circ> b \<Longrightarrow> x \<in>\<^sub>\<circ> \<Inter>\<^sub>\<circ> (set {a, b})" for x by (intro VInterI) force+
	qed

	lemma VInter_antimono:
	assumes "B \<noteq> 0" and "B \<subseteq>\<^sub>\<circ> A"
	shows "\<Inter>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> \<Inter>\<^sub>\<circ> B"
	using assms by blast

	lemma VInter_vsubset:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<subseteq>\<^sub>\<circ> B" and "A \<noteq> 0"
	shows "\<Inter>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> B"
	using assms by auto

	lemma VInter_vinsert:
	assumes "A \<noteq> 0"
	shows "\<Inter>\<^sub>\<circ> (vinsert a A) = a \<inter>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A"
	using assms by (blast intro!: vsubset_antisym)

	lemma VInter_vunion:
	assumes "A \<noteq> 0" and "B \<noteq> 0"
	shows "\<Inter>\<^sub>\<circ>(A \<union>\<^sub>\<circ> B) = \<Inter>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<Inter>\<^sub>\<circ>B"
	using assms by (blast intro!: vsubset_antisym)

	lemma VInter_vintersection:
	assumes "A \<inter>\<^sub>\<circ> B \<noteq> 0"
	shows "\<Inter>\<^sub>\<circ> A \<union>\<^sub>\<circ> \<Inter>\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> \<Inter>\<^sub>\<circ> (A \<inter>\<^sub>\<circ> B)"
	using assms by auto

	lemma VInter_VPow: "\<Inter>\<^sub>\<circ> (VPow A) \<subseteq>\<^sub>\<circ> VPow (\<Inter>\<^sub>\<circ> A)" by auto


	text\<open>Elementary properties.\<close>

	lemma VInter_lower:
	assumes "x \<in>\<^sub>\<circ> A"
	shows "\<Inter>\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> x"
	using assms by auto

	lemma VInter_greatest:
	assumes "A \<noteq> 0" and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> B \<subseteq>\<^sub>\<circ> x"
	shows "B \<subseteq>\<^sub>\<circ> \<Inter>\<^sub>\<circ> A"
	using assms by auto



	subsection\<open>Union of elements\<close>

	lemma Union_eq_VUnion: "\<Union>(elts ` elts A) = {a. \<exists>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}" by auto

	lemma small_VUnion[simp]: "small {a. \<exists>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}"
	by (fold Union_eq_VUnion) simp

	lemma VUnion_def: "\<Union>\<^sub>\<circ>A = set {a. \<exists>x \<in>\<^sub>\<circ> A. a \<in>\<^sub>\<circ> x}"
	unfolding Sup_V_def by auto


	text\<open>Rules.\<close>

	lemma VUnion_iff[simp]: "A \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>C \<longleftrightarrow> (\<exists>x\<in>\<^sub>\<circ>C. A \<in>\<^sub>\<circ> x)" by auto

	lemma VUnionI[intro]:
	assumes "x \<in>\<^sub>\<circ> A" and "a \<in>\<^sub>\<circ> x"
	shows "a \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>A"
	using assms by auto

	lemma VUnionE[elim!]:
	assumes "a \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>A" and "\<And>x. a \<in>\<^sub>\<circ> x \<Longrightarrow> x \<in>\<^sub>\<circ> A \<Longrightarrow> R"
	shows R
	using assms by clarsimp


	text\<open>Elementary properties.\<close>

	lemma VUnion_Union: "\<Union>\<^sub>\<circ>A = set (\<Union> (elts ` (elts A)))"
	by (simp add: Inf_V_def ext)


	text\<open>Set operations.\<close>

	lemma VUnion_vempty[simp]: "\<Union>\<^sub>\<circ>0 = 0" by simp

	lemma VUnion_vsingleton[simp]: "\<Union>\<^sub>\<circ>(set {a}) = a" by simp

	lemma VUnion_vdoubleton[simp]: "\<Union>\<^sub>\<circ>(set {a, b}) = a \<union>\<^sub>\<circ> b" by auto

	lemma VUnion_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B"
	shows "\<Union>\<^sub>\<circ>A \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>B"
	using assms by auto

	lemma VUnion_vinsert: "\<Union>\<^sub>\<circ>(vinsert x A) = x \<union>\<^sub>\<circ> \<Union>\<^sub>\<circ>A" by auto

	lemma VUnion_vintersection: "\<Union>\<^sub>\<circ>(A \<inter>\<^sub>\<circ> B) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>A \<inter>\<^sub>\<circ> \<Union>\<^sub>\<circ>B" by auto

	lemma VUnion_vunion[simp]: "\<Union>\<^sub>\<circ>(A \<union>\<^sub>\<circ> B) = \<Union>\<^sub>\<circ>A \<union>\<^sub>\<circ> \<Union>\<^sub>\<circ>B" by auto

	lemma VUnion_VPow[simp]: "\<Union>\<^sub>\<circ>(VPow A) = A" by auto


	text\<open>Special properties.\<close>

	lemma VUnion_vempty_conv_left: "0 = \<Union>\<^sub>\<circ>A \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>A. x = 0)" by auto

	lemma VUnion_vempty_conv_right: "\<Union>\<^sub>\<circ>A = 0 \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>A. x = 0)" by auto

	lemma vsubset_VPow_VUnion: "A \<subseteq>\<^sub>\<circ> VPow (\<Union>\<^sub>\<circ>A)" by auto

	lemma VUnion_vsubsetI:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> \<exists>y. y \<in>\<^sub>\<circ> B \<and> x \<subseteq>\<^sub>\<circ> y"
	shows "\<Union>\<^sub>\<circ>A \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>B"
	using assms by auto

	lemma VUnion_upper:
	assumes "x \<in>\<^sub>\<circ> A"
	shows "x \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>A"
	using assms by auto

	lemma VUnion_least:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<subseteq>\<^sub>\<circ> B"
	shows "\<Union>\<^sub>\<circ>A \<subseteq>\<^sub>\<circ> B"
	using assms by (fact Sup_least)



	subsection\<open>Pairs\<close>


	subsubsection\<open>Further results\<close>

	lemma small_elts_of_set[simp, intro]:
	assumes "small x"
	shows "elts (set x) = x"
	by (simp add: assms)

	lemma small_vpair[intro, simp]:
	assumes "small {a. P a}"
	shows "small {\<langle>a, b\<rangle> \| a. P a}"
	by (subgoal_tac \<open>{\<langle>a, b\<rangle> \| a. P a} = (\<lambda>a. \<langle>a, b\<rangle>) ` {a. P a}\<close>)
	(auto simp: assms)


	subsubsection\<open>\<open>vpairs\<close>\<close>

	definition vpairs :: "V \<Rightarrow> V" where
	"vpairs r = set {x. x \<in>\<^sub>\<circ> r \<and> (\<exists>a b. x = \<langle>a, b\<rangle>)}"

	lemma small_vpairs[simp]: "small {\<langle>a, b\<rangle> \| a b. \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r}"
	by (rule down[of _ r]) clarsimp


	text\<open>Rules.\<close>

	lemma vpairsI[intro]:
	assumes "x \<in>\<^sub>\<circ> r" and "x = \<langle>a, b\<rangle>"
	shows "x \<in>\<^sub>\<circ> vpairs r"
	using assms unfolding vpairs_def by auto

	lemma vpairsD[dest]:
	assumes "x \<in>\<^sub>\<circ> vpairs r"
	shows "x \<in>\<^sub>\<circ> r" and "\<exists>a b. x = \<langle>a, b\<rangle>"
	using assms unfolding vpairs_def by auto

	lemma vpairsE[elim]:
	assumes "x \<in>\<^sub>\<circ> vpairs r"
	obtains a b where "x = \<langle>a, b\<rangle>" and "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms unfolding vpairs_def by auto

	lemma vpairs_iff: "x \<in>\<^sub>\<circ> vpairs r \<longleftrightarrow> x \<in>\<^sub>\<circ> r \<and> (\<exists>a b. x = \<langle>a, b\<rangle>)" by auto


	text\<open>Elementary properties.\<close>

	lemma vpairs_iff_elts: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vpairs r \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto

	lemma vpairs_iff_pairs: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vpairs r \<longleftrightarrow> (a, b) \<in> pairs r"
	by (simp add: vpairs_iff_elts pairs_iff_elts)


	text\<open>Set operations.\<close>

	lemma vpairs_vempty[simp]: "vpairs 0 = 0" by auto

	lemma vpairs_vsingleton[simp]: "vpairs (set {\<langle>a, b\<rangle>}) = set {\<langle>a, b\<rangle>}" by auto

	lemma vpairs_vinsert: "vpairs (vinsert \<langle>a, b\<rangle> A) = set {\<langle>a, b\<rangle>} \<union>\<^sub>\<circ> vpairs A"
	by auto

	lemma vpairs_mono:
	assumes "r \<subseteq>\<^sub>\<circ> s"
	shows "vpairs r \<subseteq>\<^sub>\<circ> vpairs s"
	using assms by blast

	lemma vpairs_vunion: "vpairs (A \<union>\<^sub>\<circ> B) = vpairs A \<union>\<^sub>\<circ> vpairs B" by auto

	lemma vpairs_vintersection: "vpairs (A \<inter>\<^sub>\<circ> B) = vpairs A \<inter>\<^sub>\<circ> vpairs B" by auto

	lemma vpairs_vdiff: "vpairs (A -\<^sub>\<circ> B) = vpairs A -\<^sub>\<circ> vpairs B" by auto


	text\<open>Special properties.\<close>

	lemma vpairs_ex_vfst:
	assumes "x \<in>\<^sub>\<circ> vpairs r"
	shows "\<exists>b. \<langle>vfst x, b\<rangle> \<in>\<^sub>\<circ> r"
	using assms by force

	lemma vpairs_ex_vsnd:
	assumes "y \<in>\<^sub>\<circ> vpairs r"
	shows "\<exists>a. \<langle>a, vsnd y\<rangle> \<in>\<^sub>\<circ> r"
	using assms by force



	subsection\<open>Cartesian products\<close>

	text\<open>
	The following lemma is based on Theorem 6.2 from
	\cite{takeuti_introduction_1971}.
	\<close>

	lemma vtimes_vsubset_VPowVPow: "A \<times>\<^sub>\<circ> B \<subseteq>\<^sub>\<circ> VPow (VPow (A \<union>\<^sub>\<circ> B))"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> B"
	then obtain a b where x_def: "x = \<langle>a, b\<rangle>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B" by clarsimp
	then show "x \<in>\<^sub>\<circ> VPow (VPow (A \<union>\<^sub>\<circ> B))"
	unfolding x_def vpair_def by auto
	qed



	subsection\<open>Pairwise\<close>

	definition vpairwise :: "(V \<Rightarrow> V \<Rightarrow> bool) \<Rightarrow> V \<Rightarrow> bool"
	where "vpairwise R S \<longleftrightarrow> (\<forall>x\<in>\<^sub>\<circ>S. \<forall>y\<in>\<^sub>\<circ>S. x \<noteq> y \<longrightarrow> R x y)"


	text\<open>Rules.\<close>

	lemma vpairwiseI[intro?]:
	assumes "\<And>x y. x \<in>\<^sub>\<circ> S \<Longrightarrow> y \<in>\<^sub>\<circ> S \<Longrightarrow> x \<noteq> y \<Longrightarrow> R x y"
	shows "vpairwise R S"
	using assms by (simp add: vpairwise_def)

	lemma vpairwiseD[dest]:
	assumes "vpairwise R S" and "x \<in>\<^sub>\<circ> S" and "y \<in>\<^sub>\<circ> S" and "x \<noteq> y"
	shows "R x y" and "R y x"
	using assms unfolding vpairwise_def by auto


	text\<open>Elementary properties.\<close>

	lemma vpairwise_trivial[simp]: "vpairwise (\<lambda>i j. j \<noteq> i) I"
	by (auto simp: vpairwise_def)


	text\<open>Set operations.\<close>

	lemma vpairwise_vempty[simp]: "vpairwise P 0" by (force intro: vpairwiseI)

	lemma vpairwise_vsingleton[simp]: "vpairwise P (set {A})"
	by (simp add: vpairwise_def)

	lemma vpairwise_vinsert:
	"vpairwise r (vinsert x s) \<longleftrightarrow>
	(\<forall>y. y \<in>\<^sub>\<circ> s \<and> y \<noteq> x \<longrightarrow> r x y \<and> r y x) \<and> vpairwise r s"
	by (intro iffI conjI allI impI; (elim conjE \| tactic\<open>all_tac\<close>))
	(auto simp: vpairwise_def)

	lemma vpairwise_vsubset:
	assumes "vpairwise P S" and "T \<subseteq>\<^sub>\<circ> S"
	shows "vpairwise P T"
	using assms by (metis less_eq_V_def subset_eq vpairwiseD(2) vpairwiseI)

	lemma vpairwise_mono:
	assumes "vpairwise P A" and "\<And>x y. P x y \<Longrightarrow> Q x y" and "B \<subseteq>\<^sub>\<circ> A"
	shows "vpairwise Q B"
	using assms by (simp add: less_eq_V_def subset_eq vpairwiseD(2) vpairwiseI)



	subsection\<open>Disjoint sets\<close>

	abbreviation vdisjnt :: "V \<Rightarrow> V \<Rightarrow> bool"
	where "vdisjnt A B \<equiv> A \<inter>\<^sub>\<circ> B = 0"


	text\<open>Elementary properties.\<close>

	lemma vdisjnt_sym:
	assumes "vdisjnt A B"
	shows "vdisjnt B A"
	using assms by blast

	lemma vdisjnt_iff: "vdisjnt A B \<longleftrightarrow> (\<forall>x. ~ (x \<in>\<^sub>\<circ> A \<and> x \<in>\<^sub>\<circ> B))" by auto


	text\<open>Set operations.\<close>

	lemma vdisjnt_vempty1[simp]: "vdisjnt 0 A"
	and vdisjnt_vempty2[simp]: "vdisjnt A 0"
	by auto

	lemma vdisjnt_singleton0[simp]: "vdisjnt (set {a}) (set {b}) \<longleftrightarrow> a \<noteq> b"
	and vdisjnt_singleton1[simp]: "vdisjnt (set {a}) A \<longleftrightarrow> a \<notin>\<^sub>\<circ> A"
	and vdisjnt_singleton2[simp]: "vdisjnt A (set {a}) \<longleftrightarrow> a \<notin>\<^sub>\<circ> A"
	by force+

	lemma vdisjnt_vinsert_left: "vdisjnt (vinsert a X) Y \<longleftrightarrow> a \<notin>\<^sub>\<circ> Y \<and> vdisjnt X Y"
	by (metis vdisjnt_iff vdisjnt_sym vinsertE1 vinsertI2 vinsert_iff)

	lemma vdisjnt_vinsert_right: "vdisjnt Y (vinsert a X) \<longleftrightarrow> a \<notin>\<^sub>\<circ> Y \<and> vdisjnt Y X"
	using vdisjnt_sym vdisjnt_vinsert_left by meson

	lemma vdisjnt_vsubset_left:
	assumes "vdisjnt X Y" and "Z \<subseteq>\<^sub>\<circ> X"
	shows "vdisjnt Z Y"
	using assms by (auto intro!: vsubset_antisym)

	lemma vdisjnt_vsubset_right:
	assumes "vdisjnt X Y" and "Z \<subseteq>\<^sub>\<circ> Y"
	shows "vdisjnt X Z"
	using assms by (auto intro!: vsubset_antisym)

	lemma vdisjnt_vunion_left: "vdisjnt (A \<union>\<^sub>\<circ> B) C \<longleftrightarrow> vdisjnt A C \<and> vdisjnt B C"
	by auto

	lemma vdisjnt_vunion_right: "vdisjnt C (A \<union>\<^sub>\<circ> B) \<longleftrightarrow> vdisjnt C A \<and> vdisjnt C B"
	by auto


	text\<open>Special properties.\<close>

	lemma vdisjnt_vemptyI[intro]:
	assumes "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> B \<Longrightarrow> False"
	shows "vdisjnt A B"
	using assms by (auto intro!: vsubset_antisym)

	lemma vdisjnt_self_iff_vempty[simp]: "vdisjnt S S \<longleftrightarrow> S = 0" by auto

	lemma vdisjntI:
	assumes "\<And>x y. x \<in>\<^sub>\<circ> A \<Longrightarrow> y \<in>\<^sub>\<circ> B \<Longrightarrow> x \<noteq> y"
	shows "vdisjnt A B"
	using assms by auto

	lemma vdisjnt_nin_right:
	assumes "vdisjnt A B" and "a \<in>\<^sub>\<circ> A"
	shows "a \<notin>\<^sub>\<circ> B"
	using assms by auto

	lemma vdisjnt_nin_left:
	assumes "vdisjnt B A" and "a \<in>\<^sub>\<circ> A"
	shows "a \<notin>\<^sub>\<circ> B"
	using assms by auto

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_VNHS.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_VNHS.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_VNHS.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_VNHS.thy
	@@ -1,1074 +1,1103 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Further results related to the von Neumann hierarchy of sets\<close>
	theory CZH_Sets_VNHS
	imports
	CZH_Sets_FBRelations
	CZH_Sets_Ordinals
	begin



	subsection\<open>Background\<close>


	text\<open>
	The subsection presents several further auxiliary results about the
	von Neumann hierarchy of sets. The primary general reference for this section
	is \cite{takeuti_introduction_1971}.
	\<close>



	-subsection\<open>Further elementary properties of \<open>Vfrom\<close>\<close>
	+subsection\<open>Further properties of \<open>Vfrom\<close>\<close>


	text\<open>Reusable patterns.\<close>

	lemma Vfrom_Ord_bundle:
	assumes "A = A" and "i = i"
	shows "Vfrom A i = Vfrom A (rank i)" and "Ord (rank i)"
	by (simp_all add: Vfrom_rank_eq )

	lemma Vfrom_in_bundle:
	assumes "i \<in>\<^sub>\<circ> j" and "A = A" and "B = B"
	shows "Vfrom A i = Vfrom A (rank i)"
	and "Ord (rank i)"
	and "Vfrom B j = Vfrom B (rank j)"
	and "Ord (rank j)"
	and "rank i \<in>\<^sub>\<circ> rank j"
	by (simp_all add: assms(1) Vfrom_rank_eq Ord_mem_iff_lt rank_lt)


	text\<open>Elementary corollaries.\<close>

	lemma Ord_Vset_in_Vset_succI[intro]:
	assumes "Ord \<alpha>"
	shows "Vset \<alpha> \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	by (simp add: Vset_succ assms)

	lemma Ord_in_in_VsetI[intro]:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
	by (metis assms Ord_VsetI Ord_iff_rank rank_lt)


	text\<open>Transitivity of the constant \<^const>\<open>Vfrom\<close>.\<close>

	lemma Vfrom_trans[intro]:
	assumes "Transset A" and "x \<in>\<^sub>\<circ> X" and "X \<in>\<^sub>\<circ> Vfrom A i"
	shows "x \<in>\<^sub>\<circ> Vfrom A i"
	using Transset_def by (blast intro: assms Transset_Vfrom)

	lemma Vset_trans[intro]:
	assumes "x \<in>\<^sub>\<circ> X" and "X \<in>\<^sub>\<circ> Vset i"
	shows "x \<in>\<^sub>\<circ> Vset i"
	by (auto intro: assms)


	text\<open>Monotonicity of the constant \<^const>\<open>Vfrom\<close>.\<close>

	lemma Vfrom_in_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "i \<in>\<^sub>\<circ> j"
	shows "Vfrom A i \<in>\<^sub>\<circ> Vfrom B j"
	proof-
	define i' where "i' = rank i"
	define j' where "j' = rank j"
	note rank_conv =
	Vfrom_in_bundle[
	OF assms(2) HOL.refl[of A] HOL.refl[of B], folded i'_def j'_def
	]
	show ?thesis
	unfolding rank_conv using rank_conv(4,5)
	proof induction
	case (succ j')
	from succ have "Ord (succ j')" by auto
	from succ(3) succ.hyps have "i' \<subseteq>\<^sub>\<circ> j'" by (auto simp: Ord_def Transset_def)
	from Vfrom_mono[OF \<open>Ord i'\<close> assms(1) this] show ?case
	unfolding Vfrom_succ_Ord[OF \<open>Ord j'\<close>, of B] by simp
	next
	case (Limit j')
	from Limit(3) obtain \<xi> where "i' \<in>\<^sub>\<circ> \<xi>" and "\<xi> \<in>\<^sub>\<circ> j'" by auto
	with vifunionI have "Vfrom A i' \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>j'. Vfrom B \<xi>)"
	by (auto simp: Limit.IH)
	then show "Vfrom A i' \<in>\<^sub>\<circ> Vfrom B (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>j'. \<xi>)"
	unfolding Limit_Vfrom_eq[symmetric, OF Limit(1)]
	by (simp add: SUP_vifunion[symmetric] Limit.hyps)
	qed auto
	qed

	lemmas Vset_in_mono = Vfrom_in_mono[OF order_refl, of _ _ 0]

	lemma Vfrom_vsubset_mono:
	assumes "A \<subseteq>\<^sub>\<circ> B" and "i \<subseteq>\<^sub>\<circ> j"
	shows "Vfrom A i \<subseteq>\<^sub>\<circ> Vfrom B j"
	by (metis assms Vfrom_Ord_bundle(1,2) Vfrom_mono rank_mono)

	lemmas Vset_vsubset_mono = Vfrom_vsubset_mono[OF order_refl, of _ _ 0]

	lemma arg1_vsubset_Vfrom: "a \<subseteq>\<^sub>\<circ> Vfrom a i" using Vfrom by blast

	lemma VPow_vsubset_Vset:
	\<comment>\<open>Based on Theorem 9.10 from \cite{takeuti_introduction_1971}\<close>
	assumes "X \<in>\<^sub>\<circ> Vset i"
	shows "VPow X \<subseteq>\<^sub>\<circ> Vset i"
	proof-
	define i' where "i' = rank i"
	note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
	show ?thesis
	using rank_conv(2) assms unfolding rank_conv
	proof induction
	case (Limit \<alpha>)
	from Limit have "X \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<alpha>. Vset i)"
	by (simp add: SUP_vifunion[symmetric] Limit_Vfrom_eq)
	then have "VPow X \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<alpha>. Vset i)"
	by (intro vsubsetI) (metis Limit.IH vifunionE vifunionI vsubsetE)
	then show ?case
	by (simp add: SUP_vifunion[symmetric] Limit.hyps Limit_Vfrom_eq)
	qed (simp_all add: Vset_succ)
	qed

	lemma Vfrom_vsubset_VPow_Vfrom:
	assumes "Transset A"
	shows "Vfrom A i \<subseteq>\<^sub>\<circ> VPow (Vfrom A i)"
	using assms Transset_VPow Transset_Vfrom by (auto simp: Transset_def)

	lemma arg1_vsubset_VPow_Vfrom:
	assumes "Transset A"
	shows "A \<subseteq>\<^sub>\<circ> VPow (Vfrom A i)"
	by (meson assms Vfrom_vsubset_VPow_Vfrom arg1_vsubset_Vfrom dual_order.trans)



	subsection\<open>Operations closed with respect to \<^const>\<open>Vset\<close>\<close>


	text\<open>Empty set.\<close>

	lemma Limit_vempty_in_VsetI:
	assumes "Limit \<alpha>"
	shows "0 \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (auto simp: Limit_def)


	text\<open>Subset.\<close>

	lemma vsubset_in_VsetI[intro]:
	assumes "a \<subseteq>\<^sub>\<circ> A" and "A \<in>\<^sub>\<circ> Vset i"
	shows "a \<in>\<^sub>\<circ> Vset i"
	using assms by (auto dest: VPow_vsubset_Vset)

	lemma Ord_vsubset_in_Vset_succI:
	assumes "Ord \<alpha>" and "A \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	shows "A \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	using assms Ord_Vset_in_Vset_succI by auto


	text\<open>Power set.\<close>

	lemma Limit_VPow_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "VPow A \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(1) have "Ord \<alpha>" by auto
	with assms obtain i where "A \<in>\<^sub>\<circ> Vset i" and "i \<in>\<^sub>\<circ> \<alpha>" and "Ord i"
	by (fastforce simp: Ord_in_Ord Limit_Vfrom_eq)
	have "Vset i \<in>\<^sub>\<circ> Vset \<alpha>" by (rule Vset_in_mono) (auto intro: \<open>i \<in>\<^sub>\<circ> \<alpha>\<close>)
	from VPow_vsubset_Vset[OF \<open>A \<in>\<^sub>\<circ> Vset i\<close>] this show ?thesis
	by (rule vsubset_in_VsetI)
	qed

	lemma VPow_in_Vset_revD:
	assumes "VPow A \<in>\<^sub>\<circ> Vset i"
	shows "A \<in>\<^sub>\<circ> Vset i"
	using assms Vset_trans by blast

	lemma Ord_VPow_in_Vset_succI:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "VPow a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	using VPow_vsubset_Vset[OF assms(2)]
	by (auto intro: Ord_Vset_in_Vset_succI[OF assms(1)])

	lemma Ord_VPow_in_Vset_succD:
	assumes "Ord \<alpha>" and "VPow a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (fastforce dest: Vset_succ)


	text\<open>Union of elements.\<close>

	lemma VUnion_in_VsetI[intro]:
	assumes "A \<in>\<^sub>\<circ> Vset i"
	shows "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset i"
	proof-
	define i' where "i' = rank i"
	note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
	from rank_conv(2) assms show ?thesis
	unfolding rank_conv
	proof induction
	case (succ \<alpha>)
	show "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	by (metis succ(1,3) VPow_iff VUnion_least Vset_trans Vset_succ)
	qed (auto simp: vrange_VLambda vimage_VLambda_vrange_rep Limit_Vfrom_eq)
	qed

	lemma Limit_VUnion_in_VsetD:
	assumes "Limit \<alpha>" and "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "A \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have "A \<subseteq>\<^sub>\<circ> VPow (\<Union>\<^sub>\<circ>A)" by auto
	moreover from assms have "VPow (\<Union>\<^sub>\<circ>A) \<in>\<^sub>\<circ> Vset \<alpha>" by (rule Limit_VPow_in_VsetI)
	ultimately show ?thesis using assms(1) by auto
	qed


	text\<open>Intersection of elements.\<close>

	lemma VInter_in_VsetI[intro]:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "\<Inter>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have subset: "\<Inter>\<^sub>\<circ>A \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>A" by auto
	moreover from assms have "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>" by (rule VUnion_in_VsetI)
	ultimately show ?thesis by (rule vsubset_in_VsetI)
	qed


	text\<open>Singleton.\<close>

	lemma Limit_vsingleton_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have aa: "set {a} \<subseteq>\<^sub>\<circ> VPow a" by auto
	from assms(1) have "Ord \<alpha>" by auto
	from vsubset_in_VsetI[OF aa Limit_VPow_in_VsetI[OF assms(1)]] show ?thesis
	by (simp add: Limit_is_Ord assms(2))
	qed

	lemma Limit_vsingleton_in_VsetD:
	assumes "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by auto

	lemma Ord_vsingleton_in_Vset_succI:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set {a} \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	using assms by (simp add: Vset_succ vsubset_vsingleton_leftI)


	text\<open>Doubleton.\<close>

	lemma Limit_vdoubleton_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(1) have "Ord \<alpha>" by auto
	from assms have "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)" and "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)"
	by (simp_all add: SUP_vifunion[symmetric] Limit_Vfrom_eq)
	then obtain A B
	where a: "a \<in>\<^sub>\<circ> Vset A" and "A \<in>\<^sub>\<circ> \<alpha>" and b: "b \<in>\<^sub>\<circ> Vset B" and "B \<in>\<^sub>\<circ> \<alpha>"
	by blast
	moreover with assms have "Ord A" and "Ord B" by auto
	ultimately have "A \<union>\<^sub>\<circ> B \<in>\<^sub>\<circ> \<alpha>"
	by (metis Ord_linear_le le_iff_sup sup.order_iff)
	then have "Vset (A \<union>\<^sub>\<circ> B) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: assms Limit_is_Ord Vset_in_mono)
	moreover from a b have "set {a, b} \<subseteq>\<^sub>\<circ> Vset (A \<union>\<^sub>\<circ> B)"
	by (simp add: Vfrom_sup vsubset_vdoubleton_leftI)
	ultimately show "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>" by (rule vsubset_in_VsetI[rotated 1])
	qed

	lemma vdoubleton_in_VsetD:
	assumes "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (auto intro!: Vset_trans[of _ \<open>set {a, b}\<close>])

	lemma Ord_vdoubleton_in_Vset_succI:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set {a, b} \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	by
	(
	meson
	assms Ord_Vset_in_Vset_succI vsubset_in_VsetI vsubset_vdoubleton_leftI
	)


	text\<open>Pairwise union.\<close>

	lemma vunion_in_VsetI[intro]:
	assumes "a \<in>\<^sub>\<circ> Vset i" and "b \<in>\<^sub>\<circ> Vset i"
	shows "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset i"
	proof-
	define i' where "i' = rank i"
	note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
	show ?thesis
	using rank_conv(2) assms unfolding rank_conv
	proof induction
	case (Limit \<alpha>)
	from Limit have "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (intro Limit_vdoubleton_in_VsetI; unfold SUP_vifunion[symmetric])
	simp_all
	then have "\<Union>\<^sub>\<circ>(set {a, b}) \<in>\<^sub>\<circ> Vset \<alpha>" by (blast intro: Limit.hyps)
	with Limit.hyps VUnion_vdoubleton have "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)"
	by (auto simp: Limit_Vfrom_eq)
	then show "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. \<xi>)"
	by (simp add: \<open>Limit \<alpha>\<close> Limit_Vfrom_eq)
	qed (auto simp add: Vset_succ)
	qed

	lemma vunion_in_VsetD:
	assumes "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (meson vsubset_in_VsetI inf_sup_ord(3,4))+


	text\<open>Pairwise intersection.\<close>

	lemma vintersection_in_VsetI[intro]:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<inter>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (meson vsubset_in_VsetI inf_sup_ord(2))


	text\<open>Set difference.\<close>

	lemma vdiff_in_VsetI[intro]:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a -\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by auto


	text\<open>\<^const>\<open>vinsert\<close>.\<close>

	lemma vinsert_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have ab: "vinsert a b = set {a} \<union>\<^sub>\<circ> b" by simp
	from assms(2) have "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: Limit_vsingleton_in_VsetI assms(1))
	from this assms(1,3) show "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding ab by blast
	qed

	lemma vinsert_in_Vset_succI[intro]:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vinsert a b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	using assms by blast

	lemma vinsert_in_Vset_succI'[intro]:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	shows "vinsert a b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	proof-
	have ab: "vinsert a b = set {a} \<union>\<^sub>\<circ> b" by simp
	show ?thesis
	unfolding ab by (intro vunion_in_VsetI Ord_vsingleton_in_Vset_succI assms)
	qed

	lemma vinsert_in_VsetD:
	assumes "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms Vset_trans by blast+

	lemma Limit_insert_in_VsetI:
	assumes [intro]: "Limit \<alpha>"
	and [simp]: "small x"
	and "set x \<in>\<^sub>\<circ> Vset \<alpha>"
	and [intro]: "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set (insert a x) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have ax: "set (insert a x) = vinsert a (set x)" by auto
	from assms show ?thesis unfolding ax by auto
	qed


	text\<open>Pair.\<close>

	lemma Limit_vpair_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms Limit_vdoubleton_in_VsetI Limit_vsingleton_in_VsetI
	unfolding vpair_def
	by simp

	lemma vpair_in_VsetD[intro]:
	assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms unfolding vpair_def by (meson vdoubleton_in_VsetD)+


	text\<open>Cartesian product.\<close>

	lemma Limit_vtimes_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "A \<times>\<^sub>\<circ> B \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(1) have "Ord \<alpha>" by auto
	have "VPow (VPow (A \<union>\<^sub>\<circ> B)) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: assms Limit_VPow_in_VsetI Limit_is_Ord vunion_in_VsetI)
	from assms(1) vsubset_in_VsetI[OF vtimes_vsubset_VPowVPow this] show ?thesis
	by auto
	qed


	text\<open>Binary relations.\<close>

	lemma (in vbrelation) vbrelation_Limit_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" and "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "r \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms vdomain_vrange_vtimes by auto

	lemma
	assumes "r \<in>\<^sub>\<circ> Vset \<alpha>"
	shows vdomain_in_VsetI: "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	and vrange_in_VsetI: "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	and vfield_in_VsetI: "\<F>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms have "\<Union>\<^sub>\<circ>r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	with assms(1) have r: "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r) \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	from r assms(1) vfield_vsubset_VUnion2 show "\<F>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	from r assms(1) vdomain_vsubset_VUnion2 vrange_vsubset_VUnion2 show
	"\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	qed

	lemma (in vbrelation) vbrelation_Limit_vsubset_VsetI:
	assumes "Limit \<alpha>" and "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	shows "r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> r"
	moreover then obtain a b where x_def: "x = \<langle>a, b\<rangle>" by (elim vbrelation_vinE)
	ultimately have "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	with assms show "x \<in>\<^sub>\<circ> Vset \<alpha>" unfolding x_def by auto
	qed

	lemma
	assumes "r \<in>\<^sub>\<circ> Vset \<alpha>"
	shows fdomain_in_VsetI: "\<D>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
	and frange_in_VsetI: "\<R>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
	and ffield_in_VsetI: "\<F>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms have "\<Union>\<^sub>\<circ>r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	with assms have r: "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)) \<in>\<^sub>\<circ> Vset \<alpha>" by blast
	from r assms(1) fdomain_vsubset_VUnion2 frange_vsubset_VUnion2 show
	"\<D>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>" "\<R>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
	by auto
	from r assms(1) ffield_vsubset_VUnion2 show "\<F>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma (in vsv) vsv_Limit_vrange_in_VsetI[intro]:
	assumes "Limit \<alpha>" and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "vfinite (\<D>\<^sub>\<circ> r)"
	shows "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms(3,1,2) vsv_axioms
	proof(induction \<open>\<D>\<^sub>\<circ> r\<close> arbitrary: r rule: vfinite_induct)
	case vempty
	interpret r': vsv r by (rule vempty(4))
	from vempty(1) r'.vlrestriction_vdomain have "r = 0" by simp
	from Vset_in_mono vempty.prems(1) show ?case
	unfolding \<open>r = 0\<close> by (auto simp: Limit_def)
	next
	case (vinsert x F)
	interpret r': vsv r by (rule vinsert(7))
	have RrF_Rr: "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	have F_DrF: "F = \<D>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F)"
	unfolding vdomain_vlrestriction vinsert(4)[symmetric] by auto
	moreover note assms(1)
	moreover from RrF_Rr vinsert(6) have "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
	moreover have "vsv (r \<restriction>\<^sup>l\<^sub>\<circ> F)" by simp
	ultimately have RrF_V\<alpha>: "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<in>\<^sub>\<circ> Vset \<alpha>" by (rule vinsert(3))
	have "\<R>\<^sub>\<circ> r = vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
	proof(intro vsubset_antisym vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
	then obtain a where "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and b_def: "b = r\<lparr>a\<rparr>" by force
	with vinsert.hyps(4) have "a = x \<or> a \<in>\<^sub>\<circ> F" by auto
	with \<open>a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r\<close> show "b \<in>\<^sub>\<circ> vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
	unfolding b_def by (blast dest: r'.vsv_vimageI1)
	next
	fix b assume "b \<in>\<^sub>\<circ> vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
	with RrF_Rr r'.vsv_axioms vinsert.hyps(4) show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	qed
	moreover with vinsert.prems(2) have "r\<lparr>x\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	moreover have "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<in>\<^sub>\<circ> Vset \<alpha>" by (blast intro: RrF_V\<alpha>)
	ultimately show "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vinsert.prems(1) vinsert_in_VsetI)
	qed

	lemma (in vsv) vsv_Limit_vsv_in_VsetI[intro]:
	assumes "Limit \<alpha>"
	and "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	and "vfinite (\<D>\<^sub>\<circ> r)"
	shows "r \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: assms vsv_Limit_vrange_in_VsetI vbrelation_Limit_in_VsetI)

	lemma Limit_vcomp_in_VsetI:
	assumes "Limit \<alpha>" and "r \<in>\<^sub>\<circ> Vset \<alpha>" and "s \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "r \<circ>\<^sub>\<circ> s \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI; (intro assms(1))?)
	show "vbrelation (r \<circ>\<^sub>\<circ> s)" by auto
	have "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> s" by auto
	with assms(3) show "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: vdomain_in_VsetI vsubset_in_VsetI)
	have "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	with assms(2) show "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: vrange_in_VsetI vsubset_in_VsetI)
	qed


	text\<open>Operations on indexed families of sets.\<close>

	lemma Limit_vifintersection_in_VsetI:
	assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite I"
	shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(2) have range: "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
	from assms(1) range assms(3) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule rel_VLambda.vsv_Limit_vrange_in_VsetI[unfolded vdomain_VLambda])
	then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vimage_VLambda_vrange_rep)
	then show "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma Limit_vifunion_in_VsetI:
	assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite I"
	shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(2) have range: "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
	from assms(1) range assms(3) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule rel_VLambda.vsv_Limit_vrange_in_VsetI[unfolded vdomain_VLambda])
	then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vimage_VLambda_vrange_rep)
	then show "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma Limit_vifunion_in_Vset_if_VLambda_in_VsetI:
	assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(2) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vrange_in_VsetI)
	then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: vimage_VLambda_vrange_rep)
	then show "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma Limit_vproduct_in_VsetI:
	assumes "Limit \<alpha>"
	and "I \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
	and "vfinite I"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule Limit_vifunion_in_VsetI) (simp_all add: assms(1,3,4))
	with assms have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	with assms(1) have "VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	from vsubset_in_VsetI[OF vproduct_vsubset_VPow[of I A] this] show ?thesis
	by simp
	qed

	lemma Limit_vproduct_in_Vset_if_VLambda_in_VsetI:
	assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule Limit_vifunion_in_Vset_if_VLambda_in_VsetI)
	(simp_all add: assms)
	moreover from assms(2) have "I \<in>\<^sub>\<circ> Vset \<alpha>"
	by (metis vdomain_VLambda vdomain_in_VsetI)
	ultimately have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by auto
	with assms(1) have "VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	from vsubset_in_VsetI[OF vproduct_vsubset_VPow[of I A] this] show ?thesis
	by simp
	qed

	+lemma Limit_vdunion_in_Vset_if_VLambda_in_VsetI:
	+ assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
	+proof-
	+ interpret vsv \<open>VLambda I A\<close> by auto
	+ from assms have "\<D>\<^sub>\<circ> (VLambda I A) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (fastforce intro!: vdomain_in_VsetI)
	+ then have I: "I \<in>\<^sub>\<circ> Vset \<alpha>" by simp
	+ have "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (VLambda I A)))" by force
	+ moreover have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (VLambda I A))) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_vtimes_in_VsetI assms I VUnion_in_VsetI vrange_in_VsetI)
	+ ultimately show "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+qed
	+
	lemma vrange_vprojection_in_VsetI:
	assumes "Limit \<alpha>"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>f. f \<in>\<^sub>\<circ> A \<Longrightarrow> vsv f"
	and "\<And>f. f \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
	shows "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>)"
	then obtain f where f: "f \<in>\<^sub>\<circ> A" and y_def: "y = f\<lparr>x\<rparr>" by auto
	from f have "vsv f" and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f" by (auto intro: assms(3,4))+
	with y_def have xy: "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> f" by auto
	show "y \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))"
	proof(intro VUnionI)
	show "f \<in>\<^sub>\<circ> A" by (rule f)
	show "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> f" by (rule xy)
	show "set {x, y} \<in>\<^sub>\<circ> \<langle>x, y\<rangle>" unfolding vpair_def by simp
	qed auto
	qed
	moreover from assms(1,2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (intro VUnion_in_VsetI)
	ultimately show ?thesis by auto
	qed

	lemma Limit_vcpower_in_VsetI:
	assumes "Limit \<alpha>" and "n \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite n"
	shows "A ^\<^sub>\<times> n \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms Limit_vproduct_in_VsetI unfolding vcpower_def by auto


	text\<open>Finite sets.\<close>

	lemma Limit_vfinite_in_VsetI:
	assumes "Limit \<alpha>" and "A \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "vfinite A"
	shows "A \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms(3) obtain n where n: "n \<in>\<^sub>\<circ> \<omega>" and "n \<approx>\<^sub>\<circ> A" by clarsimp
	then obtain f where f: "v11 f" and dr: "\<D>\<^sub>\<circ> f = n" "\<R>\<^sub>\<circ> f = A" by auto
	interpret f: v11 f by (rule f)
	from n have n: "vfinite n" by auto
	show ?thesis
	by (rule f.vsv_Limit_vrange_in_VsetI[simplified dr, OF assms(1,2) n])
	qed


	text\<open>Ordinal numbers.\<close>

	lemma Limit_omega_in_VsetI:
	assumes "Limit \<alpha>"
	shows "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	from assms have "\<alpha> \<subseteq>\<^sub>\<circ> Vset \<alpha>" by force
	moreover have "\<omega> \<subseteq>\<^sub>\<circ> \<alpha>" by (simp add: assms omega_le_Limit)
	moreover have "a\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	ultimately show "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma Limit_succ_in_VsetI:
	assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "succ a \<in>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: assms succ_def vinsert_in_VsetI)


	text\<open>Sequences.\<close>

	lemma (in vfsequence) vfsequence_Limit_vcons_in_VsetI:
	assumes "Limit \<alpha>" and "x \<in>\<^sub>\<circ> Vset \<alpha>" and "xs \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vcons xs x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vcons_def
	proof(intro vinsert_in_VsetI Limit_vpair_in_VsetI assms)
	show "vcard xs \<in>\<^sub>\<circ> Vset \<alpha>"
	by (metis assms(3) vdomain_in_VsetI vfsequence_vdomain)
	qed


	text\<open>\<open>ftimes\<close>.\<close>

	lemma Limit_ftimes_in_VsetI:
	assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "A \<times>\<^sub>\<bullet> B \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding ftimes_def
	proof(rule Limit_vproduct_in_VsetI)
	from assms(1) show "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by (meson Limit_omega_in_VsetI)
	fix i assume "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	with assms(2,3) show "(i = 0 ? A : B) \<in>\<^sub>\<circ> Vset \<alpha>" by simp
	qed (auto simp: assms(1))


	text\<open>Auxiliary results.\<close>

	lemma vempty_in_Vset_succ[simp, intro]: "0 \<in>\<^sub>\<circ> Vfrom a (succ b)"
	unfolding Vfrom_succ by force

	lemma Limit_vid_on_in_Vset:
	assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "vid_on A \<in>\<^sub>\<circ> Vset \<alpha>"
	by
	(
	rule vbrelation.vbrelation_Limit_in_VsetI
	[
	OF vbrelation_vid_on assms(1) ,
	unfolded vdomain_vid_on vrange_vid_on, OF assms(2,2)
	]
	)

	lemma Ord_vpair_in_Vset_succI[intro]:
	assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset (succ (succ \<alpha>))"
	unfolding vpair_def
	proof-
	have aab: "set {set {a}, set {a, b}} = vinsert (set {a}) (set {set {a, b}})"
	by auto
	show "set {set {a}, set {a, b}} \<in>\<^sub>\<circ> Vset (succ (succ \<alpha>))"
	unfolding aab
	by
	(
	intro
	assms
	vinsert_in_Vset_succI'
	Ord_vsingleton_in_Vset_succI
	Ord_vdoubleton_in_Vset_succI
	Ord_succ
	)
	qed

	lemma Limit_vifunion_vsubset_VsetI:
	assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	then obtain i where i: "i \<in>\<^sub>\<circ> I" and "x \<in>\<^sub>\<circ> A i" by auto
	with assms(1) assms(2)[OF i] show "x \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed

	lemma Limit_vproduct_vsubset_Vset_succI:
	assumes "Limit \<alpha>" and "I \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
	proof(intro vsubsetI)
	fix a assume prems: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
	note a = vproductD[OF prems]
	interpret vsv a by (rule a(1))
	from prems have "\<R>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)" by (rule vproduct_vrange)
	moreover have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by (intro vifunion_least assms(3))
	ultimately have "\<R>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
	moreover from assms(2) prems have "\<D>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> Vset \<alpha>" unfolding a(2) by auto
	ultimately have "a \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by (intro assms(1) vbrelation_Limit_vsubset_VsetI)
	with assms(1) show "a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	by (simp add: Limit_is_Ord Ord_vsubset_in_Vset_succI)
	qed

	lemma Limit_vproduct_vsubset_Vset_succI':
	assumes "Limit \<alpha>" and "I \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
	proof-
	have "A i \<subseteq>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> I" for i
	by (simp add: Vset_trans vsubsetI assms(3) that)
	from assms(1,2) this show ?thesis by (rule Limit_vproduct_vsubset_Vset_succI)
	qed

	lemma (in vfsequence) vfsequence_Ord_vcons_in_Vset_succI:
	assumes "Ord \<alpha>"
	and "\<omega> \<in>\<^sub>\<circ> \<alpha>"
	and "x \<in>\<^sub>\<circ> Vset \<alpha>"
	and "xs \<in>\<^sub>\<circ> Vset (succ (succ (succ \<alpha>)))"
	shows "vcons xs x \<in>\<^sub>\<circ> Vset (succ (succ (succ \<alpha>)))"
	unfolding vcons_def
	proof(intro vinsert_in_Vset_succI' Ord_succ Ord_vpair_in_Vset_succI assms)
	have "vcard xs = \<D>\<^sub>\<circ> xs" by (simp add: vfsequence_vdomain)
	from assms(1,2) vfsequence_vdomain_in_omega show "vcard xs \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vfsequence_vdomain[symmetric]
	by (meson Ord_in_in_VsetI Vset_trans)
	qed

	lemma Limit_VUnion_vdomain_in_VsetI:
	assumes "Limit \<alpha>" and "Q \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-
	have "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
	proof(intro vsubsetI)
	fix a assume "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r)"
	then obtain r where r: "r \<in>\<^sub>\<circ> Q" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
	with assms obtain b where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
	show "a \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
	proof(intro VUnionI)
	show "r \<in>\<^sub>\<circ> Q" by (rule r)
	show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by (rule ab)
	show "set {a, b} \<in>\<^sub>\<circ> \<langle>a, b\<rangle>" unfolding vpair_def by simp
	qed auto
	qed
	moreover from assms(2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q)) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (blast dest!: VUnion_in_VsetI)
	ultimately show ?thesis using assms(1) by (auto simp: vsubset_in_VsetI)
	qed

	lemma Limit_VUnion_vrange_in_VsetI:
	assumes "Limit \<alpha>" and "Q \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r) \<in>\<^sub>\<circ> Vset \<alpha>"
	proof-(FIXME: duality)
	have "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
	proof(intro vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r)"
	then obtain r where r: "r \<in>\<^sub>\<circ> Q" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
	with assms obtain a where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
	show "b \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
	proof(intro VUnionI)
	show "r \<in>\<^sub>\<circ> Q" by (rule r)
	show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by (rule ab)
	show "set {a, b} \<in>\<^sub>\<circ> \<langle>a, b\<rangle>" unfolding vpair_def by simp
	qed auto
	qed
	moreover from assms(2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q)) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (blast dest!: VUnion_in_VsetI)
	ultimately show ?thesis using assms(1) by (auto simp: vsubset_in_VsetI)
	qed



	subsection\<open>Axioms for \<^term>\<open>Vset \<alpha>\<close>\<close>


	text\<open>
	The subsection demonstrates that the axioms of ZFC except for the
	Axiom Schema of Replacement hold in \<^term>\<open>Vset \<alpha>\<close> for any limit ordinal
	\<^term>\<open>\<alpha>\<close> such that \<^term>\<open>\<omega> \<in>\<^sub>\<circ> \<alpha>\<close>\footnote{The presentation of the axioms is
	loosely based on the statement of the axioms of ZFC in Chapters 1-11 in
	\cite{takeuti_introduction_1971}.}.
	\<close>

	locale \<Z> =
	fixes \<alpha>
	assumes Limit_\<alpha>[intro, simp]: "Limit \<alpha>"
	and omega_in_\<alpha>[intro, simp]: "\<omega> \<in>\<^sub>\<circ> \<alpha>"
	begin

	lemmas [intro] = \<Z>_axioms

	lemma vempty_Z_def: "0 = set {x. x \<noteq> x}" by auto

	lemma vempty_is_zet[intro, simp]: "0 \<in>\<^sub>\<circ> Vset \<alpha>"
	using Vset_in_mono omega_in_\<alpha> by auto

	lemma Axiom_of_Extensionality:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "x = y" and "x \<in>\<^sub>\<circ> a"
	shows "y \<in>\<^sub>\<circ> a" and "x \<in>\<^sub>\<circ> Vset \<alpha>" and "y \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp_all add: Vset_trans)

	lemma Axiom_of_Pairing:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp add: Limit_vdoubleton_in_VsetI)

	lemma Axiom_of_Unions:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "\<Union>\<^sub>\<circ>a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp add: VUnion_in_VsetI)

	lemma Axiom_of_Powers:
	assumes "a \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "VPow a \<in>\<^sub>\<circ> Vset \<alpha>"
	using assms by (simp add: Limit_VPow_in_VsetI)

	lemma Axiom_of_Regularity:
	assumes "a \<noteq> 0" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
	obtains x where "x \<in>\<^sub>\<circ> a" and "x \<inter>\<^sub>\<circ> a = 0"
	using assms by (auto dest: trad_foundation)

	lemma Axiom_of_Infinity: "\<omega> \<in>\<^sub>\<circ> Vset \<alpha>"
	using Limit_is_Ord by (auto simp: Ord_iff_rank Ord_VsetI OrdmemD)

	lemma Axiom_of_Choice:
	assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
	obtains f where "f \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x"
	proof-
	define f where "f = (\<lambda>x\<in>\<^sub>\<circ>A. (SOME a. a \<in>\<^sub>\<circ> x \<or> (x = 0 \<and> a = 0)))"
	interpret vsv f unfolding f_def by auto
	have A_def: "A = \<D>\<^sub>\<circ> f" unfolding f_def by simp
	have Rf: "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> vinsert 0 (\<Union>\<^sub>\<circ>A)"
	proof(rule vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	then obtain x where "x \<in>\<^sub>\<circ> A" and "y = f\<lparr>x\<rparr>"
	unfolding A_def by (blast dest: vrange_atD)
	then have y_def: "y = (SOME a. a \<in>\<^sub>\<circ> x \<or> x = 0 \<and> a = 0)"
	unfolding f_def unfolding A_def by simp
	have "y = 0 \<or> y \<in>\<^sub>\<circ> x"
	proof(cases \<open>x = 0\<close>)
	case False then show ?thesis
	unfolding y_def by (metis (mono_tags, lifting) verit_sko_ex' vemptyE)
	qed (simp add: y_def)
	with \<open>x \<in>\<^sub>\<circ> A\<close> show "y \<in>\<^sub>\<circ> vinsert 0 (\<Union>\<^sub>\<circ>A)" by clarsimp
	qed
	from assms have "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>" by (simp add: Axiom_of_Unions)
	with vempty_is_zet Limit_\<alpha> have "vinsert 0 (\<Union>\<^sub>\<circ>A) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	with Rf have "\<R>\<^sub>\<circ> f \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	with Limit_\<alpha> assms[unfolded A_def] have "f \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	moreover have "x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x" for x
	proof-
	assume prems: "x \<in>\<^sub>\<circ> A" "x \<noteq> 0"
	then have "f\<lparr>x\<rparr> = (SOME a. a \<in>\<^sub>\<circ> x \<or> (x = 0 \<and> a = 0))"
	unfolding f_def by simp
	with prems(2) show "f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x"
	by (metis (mono_tags, lifting) someI_ex vemptyE)
	qed
	ultimately show ?thesis by (simp add: that)
	qed

	end


	text\<open>Trivial corollaries.\<close>

	lemma (in \<Z>) Ord_\<alpha>: "Ord \<alpha>" by auto

	lemma (in \<Z>) \<Z>_Vset_\<omega>2_vsubset_Vset: "Vset (\<omega> + \<omega>) \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	by (simp add: Vset_vsubset_mono omega2_vsubset_Limit)

	lemma (in \<Z>) \<Z>_Limit_\<alpha>\<omega>: "Limit (\<alpha> + \<omega>)" by (simp add: Limit_is_Ord)

	lemma (in \<Z>) \<Z>_\<alpha>_\<alpha>\<omega>: "\<alpha> \<in>\<^sub>\<circ> \<alpha> + \<omega>"
	by (simp add: Limit_is_Ord Ord_mem_iff_lt)

	lemma (in \<Z>) \<Z>_\<omega>_\<alpha>\<omega>: "\<omega> \<in>\<^sub>\<circ> \<alpha> + \<omega>"
	using add_le_cancel_left0 by blast

	lemma \<Z>_\<omega>\<omega>: "\<Z> (\<omega> + \<omega>)"
	using \<omega>_gt0 by (auto intro: \<Z>.intro simp: Ord_mem_iff_lt)

	lemma (in \<Z>) in_omega_in_omega_plus[intro]:
	assumes "a \<in>\<^sub>\<circ> \<omega>"
	shows "a \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)"
	proof-
	from assms have "a \<in>\<^sub>\<circ> Vset \<omega>" by auto
	moreover have "Vset \<omega> \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)" by (simp add: Vset_in_mono \<Z>_\<omega>_\<alpha>\<omega>)
	ultimately show "a \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)" by auto
	qed

	lemma (in \<Z>) ord_of_nat_in_Vset[simp]: "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by force


	+text\<open>\<open>vfsequences_on\<close>.\<close>
	+
	+lemma (in \<Z>) vfsequences_on_in_VsetI:
	+ assumes "X \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "vfsequences_on X \<in>\<^sub>\<circ> Vset \<alpha>"
	+proof-
	+ from vfsequences_on_subset_\<omega>_set have "vfsequences_on X \<subseteq>\<^sub>\<circ> VPow (\<omega> \<times>\<^sub>\<circ> X)"
	+ by (auto simp: less_eq_V_def)
	+ moreover have "VPow (\<omega> \<times>\<^sub>\<circ> X) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_VPow_in_VsetI Limit_vtimes_in_VsetI assms Axiom_of_Infinity)
	+ auto
	+ ultimately show ?thesis by auto
	+qed
	+
	+

	subsection\<open>Existence of a disjoint subset in \<^term>\<open>Vset \<alpha>\<close>\<close>

	definition mk_doubleton :: "V \<Rightarrow> V \<Rightarrow> V"
	where "mk_doubleton X a = set {a, X}"

	definition mk_doubleton_image :: "V \<Rightarrow> V \<Rightarrow> V"
	where "mk_doubleton_image X Y = set (mk_doubleton Y ` elts X)"

	lemma inj_on_mk_doubleton: "inj_on (mk_doubleton X) (elts X)"
	proof
	fix a b assume "mk_doubleton X a = mk_doubleton X b"
	then have "{a, X} = {b, X}" unfolding mk_doubleton_def by auto
	then show "a = b" by (metis doubleton_eq_iff)
	qed

	lemma mk_doubleton_image_vsubset_veqpoll:
	assumes "X \<subseteq>\<^sub>\<circ> Y"
	shows "mk_doubleton_image X X \<approx>\<^sub>\<circ> mk_doubleton_image X Y"
	unfolding eqpoll_def
	proof(intro exI[of _ \<open>\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})\<close>] bij_betw_imageI)
	show "inj_on (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) (elts (mk_doubleton_image X X))"
	unfolding mk_doubleton_image_def
	proof(intro inj_onI)
	fix y y' assume prems:
	"y \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
	"y' \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
	"vinsert Y (y -\<^sub>\<circ> set {X}) = vinsert Y (y' -\<^sub>\<circ> set {X})"
	then obtain x x'
	where "x \<in>\<^sub>\<circ> X"
	and "x' \<in>\<^sub>\<circ> X"
	and y_def: "y = set {x, X}"
	and y'_def: "y' = set {x', X}"
	by (clarsimp simp: mk_doubleton_def)
	with assms have xX_X: "set {x, X} -\<^sub>\<circ> set {X} = set {x}"
	and x'X_X: "set {x', X} -\<^sub>\<circ> set {X} = set {x'}"
	by fastforce+
	from prems(3)[unfolded y_def y'_def] have "set {x, Y} = set {x', Y}"
	unfolding xX_X x'X_X by auto
	then have "x = x'" by (auto simp: doubleton_eq_iff)
	then show "y = y'" unfolding y_def y'_def by simp
	qed
	show
	"(\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X)) =
	(elts (mk_doubleton_image X Y))"
	proof(intro subset_antisym subsetI)
	fix z
	assume prems:
	"z \<in> (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X))"
	then obtain y
	where "y \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
	and z_def: "z = vinsert Y (y -\<^sub>\<circ> set {X})"
	unfolding mk_doubleton_image_def by auto
	then obtain x where xX: "x \<in>\<^sub>\<circ> X" and y_def: "y = set {x, X}"
	unfolding mk_doubleton_def by clarsimp
	from xX have y_X: "y -\<^sub>\<circ> set {X} = set {x}" unfolding y_def by fastforce
	from z_def have z_def': "z = set {x, Y}"
	unfolding y_X by (simp add: doubleton_eq_iff vinsert_vsingleton)
	from xX show "z \<in>\<^sub>\<circ> mk_doubleton_image X Y"
	unfolding z_def' mk_doubleton_def mk_doubleton_image_def by simp
	next
	fix z assume prems: "z \<in>\<^sub>\<circ> mk_doubleton_image X Y"
	then obtain x where xX: "x \<in>\<^sub>\<circ> X" and z_def: "z = set {x, Y}"
	unfolding mk_doubleton_def mk_doubleton_image_def by clarsimp
	from xX have xX_XX: "set {x, X} \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
	unfolding mk_doubleton_def by simp
	from xX have xX_X: "set {x, X} -\<^sub>\<circ> set {X} = set {x}" by fastforce
	have z_def': "z = vinsert Y (set {x, X} -\<^sub>\<circ> set {X})"
	unfolding xX_X z_def by auto
	with xX_XX show
	"z \<in> (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X))"
	unfolding z_def' mk_doubleton_image_def by simp
	qed
	qed

	lemma mk_doubleton_image_veqpoll:
	assumes "X \<subseteq>\<^sub>\<circ> Y"
	shows "X \<approx>\<^sub>\<circ> mk_doubleton_image X Y"
	proof-
	have "X \<approx>\<^sub>\<circ> mk_doubleton_image X X"
	unfolding mk_doubleton_image_def by (auto simp: inj_on_mk_doubleton)
	also have "\<dots> \<approx> elts (mk_doubleton_image X Y)"
	by (rule mk_doubleton_image_vsubset_veqpoll[OF assms])
	finally show "X \<approx>\<^sub>\<circ> mk_doubleton_image X Y".
	qed

	lemma vdisjnt_mk_doubleton_image: "vdisjnt (mk_doubleton_image X Y) Y"
	proof
	fix b assume prems: "b \<in>\<^sub>\<circ> Y" "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
	then obtain a where "a \<in>\<^sub>\<circ> X" and "set {a, Y} = b"
	unfolding mk_doubleton_def mk_doubleton_image_def by clarsimp
	then have "Y \<in>\<^sub>\<circ> b" by clarsimp
	with mem_not_sym show False by (simp add: prems)
	qed

	lemma Limit_mk_doubleton_image_vsubset_Vset:
	assumes "Limit \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "mk_doubleton_image X Y \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
	then obtain a where "b = mk_doubleton Y a" and "a \<in>\<^sub>\<circ> X"
	unfolding mk_doubleton_image_def by clarsimp
	with assms have b_def: "b = set {a, Y}" and a\<alpha>: "a \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: mk_doubleton_def)
	from this(2) assms show "b \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding b_def by (simp add: Limit_vdoubleton_in_VsetI)
	qed

	lemma Ord_mk_doubleton_image_vsubset_Vset_succ:
	assumes "Ord \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	shows "mk_doubleton_image X Y \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
	proof(intro vsubsetI)
	fix b assume "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
	then obtain a where "b = mk_doubleton Y a" and "a \<in>\<^sub>\<circ> X"
	unfolding mk_doubleton_image_def by clarsimp
	with assms have b_def: "b = set {a, Y}" and a\<alpha>: "a \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: mk_doubleton_def)
	from this(2) assms show "b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
	unfolding b_def by (simp add: Ord_vdoubleton_in_Vset_succI)
	qed

	lemma Limit_ex_eqpoll_vdisjnt:
	assumes "Limit \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	obtains Z where "X \<approx>\<^sub>\<circ> Z" and "vdisjnt Z Y" and "Z \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	using assms
	by (intro that[of \<open>mk_doubleton_image X Y\<close>])
	(
	simp_all add:
	mk_doubleton_image_veqpoll
	vdisjnt_mk_doubleton_image
	Limit_mk_doubleton_image_vsubset_Vset
	)

	lemma Ord_ex_eqpoll_vdisjnt:
	assumes "Ord \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
	obtains Z where "X \<approx>\<^sub>\<circ> Z" and "vdisjnt Z Y" and "Z \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
	using assms
	by (intro that[of \<open>mk_doubleton_image X Y\<close>])
	(
	simp_all add:
	mk_doubleton_image_veqpoll
	vdisjnt_mk_doubleton_image
	Ord_mk_doubleton_image_vsubset_Vset_succ
	)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/CZH_Sets_ZQR.thy b/thys/CZH_Foundations/czh_sets/CZH_Sets_ZQR.thy
	--- a/thys/CZH_Foundations/czh_sets/CZH_Sets_ZQR.thy
	+++ b/thys/CZH_Foundations/czh_sets/CZH_Sets_ZQR.thy
	@@ -1,2180 +1,2194 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>
	Construction of integer numbers, rational numbers and real numbers
	\<close>
	theory CZH_Sets_ZQR
	imports
	"HOL-Library.Rewrite"
	CZH_Sets_NOP
	CZH_Sets_VNHS
	HOL_CContinuum
	begin



	subsection\<open>Background\<close>


	text\<open>

	The set of real numbers \<open>\<real>\<^sub>\<circ>\<close> is defined in a way such that it agrees
	with the set of natural numbers \<^const>\<open>\<omega>\<close>. However, otherwise,
	real numbers are allowed to be arbitrary sets
	in \<^term>\<open>Vset (\<omega> + \<omega>)\<close>.\footnote{
	The idea itself is not new, e.g., see \cite{chen_hotg_2021}.
	}
	Integer and rational numbers are exposed via canonical injections into
	the set of real numbers from the types \<^typ>\<open>int\<close> and \<^typ>\<open>rat\<close>, respectively.
	Lastly, common operations on the real, integer and rational numbers
	are defined and some of their main properties are exposed.

	The primary reference for this section is the textbook
	\<open>The Real Numbers and Real Analysis\<close> by E. Bloch
	\cite{bloch_real_2010}. Nonetheless, it is not claimed that the exposition of
	the subject presented in this section is entirely congruent with the exposition
	in the aforementioned reference.

	\<close>

	declare One_nat_def[simp del]

	named_theorems vnumber_simps

	lemmas [vnumber_simps] =
	Collect_mem_eq Ball_def[symmetric] Bex_def[symmetric] vsubset_eq[symmetric]


	text\<open>
	Supplementary material for the evaluation of the upper bound of the
	cardinality of the continuum.
	\<close>

	lemma inj_image_ord_of_nat: "inj (image ord_of_nat)"
	by (intro injI) (simp add: inj_image_eq_iff inj_ord_of_nat)

	lemma vlepoll_VPow_omega_if_vreal_lepoll_real:
	assumes "x \<lesssim> (UNIV::real set)"
	shows "set x \<lesssim>\<^sub>\<circ> VPow \<omega>"
	proof-
	note x = assms
	also from real_lepoll_natnat have "\<dots> \<lesssim> (UNIV::nat set set)"
	unfolding Pow_UNIV by simp
	also from inj_image_ord_of_nat have "\<dots> \<lesssim> Pow (elts \<omega>)"
	unfolding lepoll_def by auto
	also from down have "\<dots> \<lesssim> elts (VPow \<omega>)"
	unfolding lepoll_def
	by (intro exI[of _ set] conjI inj_onI) (auto simp: elts_VPow)
	finally show "set x \<lesssim>\<^sub>\<circ> VPow \<omega>" by simp
	qed



	subsection\<open>Real numbers\<close>


	subsubsection\<open>Definition\<close>

	abbreviation real :: "nat \<Rightarrow> real"
	where "real \<equiv> of_nat"

	definition nat_of_real :: "real \<Rightarrow> nat"
	where "nat_of_real = inv_into UNIV real"

	definition vreal_of_real_impl :: "real \<Rightarrow> V"
	where "vreal_of_real_impl = (SOME V_of::real\<Rightarrow>V. inj V_of)"

	lemma inj_vreal_of_real_impl: "inj vreal_of_real_impl"
	unfolding vreal_of_real_impl_def
	by (metis embeddable_class.ex_inj verit_sko_ex')

	lemma inj_on_inv_vreal_of_real_impl:
	"inj_on (inv vreal_of_real_impl) (range vreal_of_real_impl)"
	by (intro inj_onI) (fastforce intro: inv_into_injective)

	lemma range_vreal_of_real_impl_vlepoll_VPow_omega:
	"set (range vreal_of_real_impl) \<lesssim>\<^sub>\<circ> VPow \<omega>"
	proof-
	have "range vreal_of_real_impl \<lesssim> (UNIV::real set)"
	unfolding lepoll_def by (auto intro: inj_on_inv_vreal_of_real_impl)
	from vlepoll_VPow_omega_if_vreal_lepoll_real[OF this] show ?thesis .
	qed

	definition vreal_impl :: V
	where "vreal_impl =
	(
	SOME y.
	range vreal_of_real_impl \<approx> elts y \<and>
	vdisjnt y \<omega> \<and>
	y \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)
	)"

	lemma vreal_impl_eqpoll: "range vreal_of_real_impl \<approx> elts vreal_impl"
	and vreal_impl_vdisjnt: "vdisjnt vreal_impl \<omega>"
	and vreal_impl_in_Vset_ss_omega: "vreal_impl \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	proof-
	from Ord_\<omega> have VPow_in_Vset: "VPow \<omega> \<in>\<^sub>\<circ> Vset (succ (succ \<omega>))"
	by (intro Ord_VPow_in_Vset_succI)
	(auto simp: less_TC_succ Ord_iff_rank VsetI)
	have [simp]: "small (range vreal_of_real_impl)" by simp
	then obtain x where x: "range vreal_of_real_impl = elts x"
	unfolding small_iff by clarsimp
	from range_vreal_of_real_impl_vlepoll_VPow_omega[unfolded x] have
	"x \<lesssim>\<^sub>\<circ> VPow \<omega>"
	by simp
	then obtain f where "v11 f" and "\<D>\<^sub>\<circ> f = x" and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> VPow \<omega>" by auto
	moreover have O\<omega>2: "Ord (succ (succ \<omega>))" by auto
	ultimately have x_Rf: "x \<approx>\<^sub>\<circ> \<R>\<^sub>\<circ> f" and "\<R>\<^sub>\<circ> f \<in>\<^sub>\<circ> Vset (succ (succ \<omega>))"
	by (auto intro: VPow_in_Vset)
	then have "\<omega> \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> f \<in>\<^sub>\<circ> Vset (succ (succ \<omega>))" and "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> \<omega> \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
	by (auto simp: VPow_in_Vset VPow_in_Vset_revD vunion_in_VsetI)
	from Ord_ex_eqpoll_vdisjnt[OF O\<omega>2 this(2,1)] obtain z
	where Rf_z: "\<R>\<^sub>\<circ> f \<approx>\<^sub>\<circ> z"
	and "vdisjnt z (\<omega> \<union>\<^sub>\<circ> \<R>\<^sub>\<circ> f)"
	and z: "z \<subseteq>\<^sub>\<circ> Vset (succ (succ (succ \<omega>)))"
	by auto
	then have vdisjnt_z\<omega>: "vdisjnt z \<omega>"
	and z_ssss\<omega>: "z \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<omega>))))"
	by
	(
	auto simp:
	vdisjnt_vunion_right vsubset_in_VsetI Ord_succ Ord_Vset_in_Vset_succI
	)
	have "Limit (\<omega> + \<omega>)" by simp
	then have "succ (succ (succ (succ \<omega>))) \<in>\<^sub>\<circ> \<omega> + \<omega>"
	by (metis Limit_def add.right_neutral add_mem_right_cancel Limit_omega)
	then have "Vset (succ (succ (succ (succ \<omega>)))) \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	by (simp add: Vset_in_mono)
	with z z_ssss\<omega> have "z \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)" by auto
	moreover from x_Rf Rf_z have "range vreal_of_real_impl \<approx> elts z"
	unfolding x by (auto intro: eqpoll_trans)
	ultimately show "range vreal_of_real_impl \<approx> elts vreal_impl"
	and "vdisjnt vreal_impl \<omega>"
	and "vreal_impl \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	using vdisjnt_z\<omega>
	unfolding vreal_impl_def
	by (metis (mono_tags, lifting) verit_sko_ex')+
	qed

	definition vreal_of_real_impl' :: "V \<Rightarrow> V"
	where "vreal_of_real_impl' =
	(SOME f. bij_betw f (range vreal_of_real_impl) (elts vreal_impl))"

	lemma vreal_of_real_impl'_bij_betw:
	"bij_betw vreal_of_real_impl' (range vreal_of_real_impl) (elts vreal_impl)"
	proof-
	from eqpoll_def obtain f where f:
	"bij_betw f (range vreal_of_real_impl) (elts vreal_impl)"
	by (auto intro: vreal_impl_eqpoll)
	then show ?thesis unfolding vreal_of_real_impl'_def by (metis verit_sko_ex')
	qed

	definition vreal_of_real_impl'' :: "real \<Rightarrow> V"
	where "vreal_of_real_impl'' = vreal_of_real_impl' \<circ> vreal_of_real_impl"

	lemma vreal_of_real_impl'': "disjnt (range vreal_of_real_impl'') (elts \<omega>)"
	proof-
	from comp_apply vreal_impl_vdisjnt vreal_of_real_impl'_bij_betw have
	"vreal_of_real_impl'' y \<notin>\<^sub>\<circ> \<omega>" for y
	unfolding vreal_of_real_impl''_def by fastforce
	then show ?thesis unfolding disjnt_iff by clarsimp
	qed

	lemma inj_vreal_of_real_impl'': "inj vreal_of_real_impl''"
	unfolding vreal_of_real_impl''_def
	by
	(
	meson
	bij_betwE
	comp_inj_on
	inj_vreal_of_real_impl
	vreal_of_real_impl'_bij_betw
	)


	text\<open>Main definitions.\<close>

	definition vreal_of_real :: "real \<Rightarrow> V"
	where "vreal_of_real x =
	(if x \<in> \<nat> then (nat_of_real x)\<^sub>\<nat> else vreal_of_real_impl'' x)"

	notation vreal_of_real (\<open>_\<^sub>\<real>\<close> [1000] 999)

	declare [[coercion "vreal_of_real :: real \<Rightarrow> V"]]

	definition vreal :: V (\<open>\<real>\<^sub>\<circ>\<close>)
	where "vreal = set (range vreal_of_real)"

	definition real_of_vreal :: "V \<Rightarrow> real"
	where "real_of_vreal = inv_into UNIV vreal_of_real"


	text\<open>Rules.\<close>

	lemma vreal_of_real_in_vrealI[intro, simp]: "a\<^sub>\<real> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	by (simp add: vreal_def)

	lemma vreal_of_real_in_vrealE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	obtains b where "b\<^sub>\<real> = a"
	using assms unfolding vreal_def by auto


	text\<open>Elementary properties.\<close>

	lemma vnat_eq_vreal: "x\<^sub>\<nat> = x\<^sub>\<real>" by (simp add: nat_of_real_def vreal_of_real_def)

	lemma omega_vsubset_vreal: "\<omega> \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof
	fix x assume "x \<in>\<^sub>\<circ> \<omega>"
	with nat_of_omega obtain y where x_def: "x = y\<^sub>\<nat>" by auto
	then have "vreal_of_real (real y) = (nat_of_real (real y))\<^sub>\<nat>"
	unfolding vreal_of_real_def by simp
	moreover have "(nat_of_real (real y))\<^sub>\<nat> = x"
	by (simp add: nat_of_real_def x_def)
	ultimately show "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" unfolding vreal_def by clarsimp
	qed

	lemma inj_vreal_of_real: "inj vreal_of_real"
	proof
	fix x y assume prems: "vreal_of_real x = vreal_of_real y"
	consider
	(xy) \<open>x \<in> \<nat> \<and> y \<in> \<nat>\<close> \|
	(x_ny) \<open>x \<in> \<nat> \<and> y \<notin> \<nat>\<close> \|
	(nx_y) \<open>x \<notin> \<nat> \<and> y \<in> \<nat>\<close> \|
	(nxy) \<open>x \<notin> \<nat> \<and> y \<notin> \<nat>\<close>
	by auto
	then show "x = y"
	proof cases
	case xy
	then have "(nat_of_real x)\<^sub>\<nat> = (nat_of_real y)\<^sub>\<nat>"
	using vreal_of_real_def prems by simp
	then show ?thesis
	by (metis Nats_def f_inv_into_f nat_of_real_def ord_of_nat_inject xy)
	next
	case x_ny
	with prems have eq: "(nat_of_real x)\<^sub>\<nat> = vreal_of_real_impl'' y"
	unfolding vreal_of_real_def by simp
	have "vreal_of_real_impl'' y \<notin>\<^sub>\<circ> \<omega>"
	by (meson disjnt_iff rangeI vreal_of_real_impl'')
	then show ?thesis unfolding eq[symmetric] by auto
	next
	case nx_y
	with prems have eq: "(nat_of_real y)\<^sub>\<nat> = vreal_of_real_impl'' x"
	unfolding vreal_of_real_def by simp
	have "vreal_of_real_impl'' x \<notin>\<^sub>\<circ> \<omega>"
	by (meson disjnt_iff rangeI vreal_of_real_impl'')
	then show ?thesis unfolding eq[symmetric] by auto
	next
	case nxy
	then have "x \<notin> \<nat>" and "y \<notin> \<nat>" by auto
	with prems
	have "vreal_of_real_impl'' x = vreal_of_real_impl'' y"
	unfolding vreal_of_real_def by simp
	then show ?thesis by (meson inj_def inj_vreal_of_real_impl'')
	qed
	qed

	lemma vreal_in_Vset_\<omega>2: "\<real>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	unfolding vreal_def
	proof-
	have "set (range vreal_of_real) \<subseteq>\<^sub>\<circ> set (range vreal_of_real_impl'') \<union>\<^sub>\<circ> \<omega>"
	unfolding vreal_of_real_def by auto
	moreover from vreal_of_real_impl'_bij_betw have
	"set (range vreal_of_real_impl'') \<subseteq>\<^sub>\<circ> vreal_impl"
	unfolding vreal_of_real_impl''_def by fastforce
	ultimately show "set (range vreal_of_real) \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	using Ord_\<omega> Ord_add
	by
	(
	auto simp:
	Ord_iff_rank
	Ord_VsetI
	vreal_impl_in_Vset_ss_omega
	vsubset_in_VsetI
	vunion_in_VsetI
	)
	qed

	lemma real_of_vreal_vreal_of_real[simp]: "real_of_vreal (a\<^sub>\<real>) = a"
	by (simp add: inj_vreal_of_real real_of_vreal_def)


	subsubsection\<open>Transfer rules\<close>

	definition cr_vreal :: "V \<Rightarrow> real \<Rightarrow> bool"
	where "cr_vreal a b \<longleftrightarrow> (a = vreal_of_real b)"

	lemma cr_vreal_right_total[transfer_rule]: "right_total cr_vreal"
	unfolding cr_vreal_def right_total_def by simp

	lemma cr_vreal_bi_uniqie[transfer_rule]: "bi_unique cr_vreal"
	unfolding cr_vreal_def bi_unique_def
	by (simp add: inj_eq inj_vreal_of_real)

	lemma cr_vreal_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_vreal = (\<lambda>x. x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>)"
	unfolding cr_vreal_def by force

	lemma vreal_transfer[transfer_rule]:
	"(rel_set cr_vreal) (elts \<real>\<^sub>\<circ>) (UNIV::real set)"
	unfolding cr_vreal_def rel_set_def by auto

	lemma vreal_of_real_transfer[transfer_rule]: "cr_vreal (vreal_of_real a) a"
	unfolding cr_vreal_def by auto


	subsubsection\<open>Constants and operations\<close>


	text\<open>Auxiliary.\<close>

	lemma vreal_fsingleton_in_fproduct_vreal: "[a\<^sub>\<real>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 1\<^sub>\<nat>" by auto

	lemma vreal_fpair_in_fproduct_vreal: "[a\<^sub>\<real>, b\<^sub>\<real>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" by force


	text\<open>Zero.\<close>

	lemma vreal_zero: "0\<^sub>\<real> = (0::V)"
	by (simp add: ord_of_nat_vempty vnat_eq_vreal)


	text\<open>One.\<close>

	lemma vreal_one: "1\<^sub>\<real> = (1::V)"
	by (simp add: ord_of_nat_vone vnat_eq_vreal)


	text\<open>Addition.\<close>

	definition vreal_plus :: V
	where "vreal_plus =
	(\<lambda>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (real_of_vreal (x\<lparr>0\<^sub>\<nat>\<rparr>) + real_of_vreal (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<real>)"

	abbreviation vreal_plus_app :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "+\<^sub>\<real>" 65)
	where "vreal_plus_app a b \<equiv> vreal_plus\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	notation vreal_plus_app (infixl "+\<^sub>\<real>" 65)

	lemma vreal_plus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal ===> cr_vreal)
	(+\<^sub>\<real>) (+)"
	using vreal_fpair_in_fproduct_vreal
	by (intro rel_funI, unfold vreal_plus_def cr_vreal_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Multiplication.\<close>

	definition vreal_mult :: V
	where "vreal_mult =
	(\<lambda>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (real_of_vreal (x\<lparr>0\<^sub>\<nat>\<rparr>) * real_of_vreal (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<real>)"

	abbreviation vreal_mult_app (infixl "*\<^sub>\<real>" 70)
	where "vreal_mult_app a b \<equiv> vreal_mult\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	notation vreal_mult_app (infixl "*\<^sub>\<real>" 70)

	lemma vreal_mult_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal ===> cr_vreal) (\<^sub>\<real>) ()"
	using vreal_fpair_in_fproduct_vreal
	by (intro rel_funI, unfold vreal_mult_def cr_vreal_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Unary minus.\<close>

	definition vreal_uminus :: V
	where "vreal_uminus = (\<lambda>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ>. (uminus (real_of_vreal x))\<^sub>\<real>)"

	abbreviation vreal_uminus_app (\<open>-\<^sub>\<real> _\<close> [81] 80)
	where "-\<^sub>\<real> a \<equiv> vreal_uminus\<lparr>a\<rparr>"

	lemma vreal_uminus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal) (vreal_uminus_app) (uminus)"
	using vreal_fsingleton_in_fproduct_vreal
	by (intro rel_funI, unfold vreal_uminus_def cr_vreal_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Multiplicative inverse.\<close>

	definition vreal_inverse :: V
	where "vreal_inverse = (\<lambda>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ>. (inverse (real_of_vreal x))\<^sub>\<real>)"

	abbreviation vreal_inverse_app (\<open>(_\<inverse>\<^sub>\<real>)\<close> [1000] 999)
	where "a\<inverse>\<^sub>\<real> \<equiv> vreal_inverse\<lparr>a\<rparr>"

	lemma vreal_inverse_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal) (vreal_inverse_app) (inverse)"
	using vreal_fsingleton_in_fproduct_vreal
	by (intro rel_funI, unfold vreal_inverse_def cr_vreal_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Order.\<close>

	definition vreal_le :: V
	where "vreal_le =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> real_of_vreal a \<le> real_of_vreal b}"

	abbreviation vreal_le' (\<open>(_/ \<le>\<^sub>\<real> _)\<close> [51, 51] 50)
	where "a \<le>\<^sub>\<real> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vreal_le"

	lemma small_vreal_le[simp]:
	"small
	{[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> real_of_vreal a \<le> real_of_vreal b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vreal_le_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal ===> (=)) vreal_le' (\<le>)"
	using vreal_fsingleton_in_fproduct_vreal
	by (intro rel_funI, unfold cr_scalar_def cr_vreal_def vreal_le_def)
	(auto simp: nat_omega_simps)


	text\<open>Strict order.\<close>

	definition vreal_ls :: V
	where "vreal_ls =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> real_of_vreal a < real_of_vreal b}"

	abbreviation vreal_ls' (\<open>(_/ <\<^sub>\<real> _)\<close> [51, 51] 50)
	where "a <\<^sub>\<real> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vreal_ls"

	lemma small_vreal_ls[simp]:
	"small
	{[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> real_of_vreal a < real_of_vreal b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vreal_ls_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal ===> (=)) vreal_ls' (<)"
	by (intro rel_funI, unfold cr_scalar_def cr_vreal_def vreal_ls_def)
	(auto simp: nat_omega_simps)


	text\<open>Subtraction.\<close>

	definition vreal_minus :: V
	where "vreal_minus =
	(\<lambda>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (real_of_vreal (x\<lparr>0\<^sub>\<nat>\<rparr>) - real_of_vreal (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<real>)"

	abbreviation vreal_minus_app (infixl "-\<^sub>\<real>" 65)
	where "vreal_minus_app a b \<equiv> vreal_minus\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vreal_minus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vreal ===> cr_vreal ===> cr_vreal) (-\<^sub>\<real>) (-)"
	using vreal_fpair_in_fproduct_vreal
	by (intro rel_funI, unfold vreal_minus_def cr_vreal_def cr_scalar_def)
	(simp add: nat_omega_simps)


	subsubsection\<open>Axioms of an ordered field with the least upper bound property.\<close>


	text\<open>
	The exposition follows the Definitions 2.2.1 and 2.2.3 from
	the textbook \<open>The Real Numbers and Real Analysis\<close> by E. Bloch
	\cite{bloch_real_2010}.
	\<close>

	lemma vreal_zero_closed: "0\<^sub>\<real> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "(0::real) \<in> UNIV" by simp
	from this[untransferred] show ?thesis.
	qed

	lemma vreal_one_closed: "1\<^sub>\<real> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "(1::real) \<in> UNIV" by simp
	from this[untransferred] show ?thesis.
	qed

	lemma vreal_plus_closed:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x +\<^sub>\<real> y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "x' + y' \<in> UNIV" for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vreal_uminus_closed:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "-\<^sub>\<real> x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "-x' \<in> UNIV" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vreal_mult_closed:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x *\<^sub>\<real> y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "x' * y' \<in> UNIV" for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vreal_inverse_closed:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x\<inverse>\<^sub>\<real> \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "inverse x' \<in> UNIV" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Addition: Definition 2.2.1.a.\<close>

	lemma vreal_assoc_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "(x +\<^sub>\<real> y) +\<^sub>\<real> z = x +\<^sub>\<real> (y +\<^sub>\<real> z)"
	proof-
	have "(x' + y') + z' = x' + (y' + z')" for x' y' z' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Addition: Definition 2.2.1.b.\<close>

	lemma vreal_commutative_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x +\<^sub>\<real> y = y +\<^sub>\<real> x"
	proof-
	have "(x' + y') = y' + x' " for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for Addition: Definition 2.2.1.c.\<close>

	lemma vreal_identity_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x +\<^sub>\<real> 0\<^sub>\<real> = x"
	proof-
	have "x' + 0 = x'" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Inverses Law for Addition: Definition 2.2.1.d.\<close>

	lemma vreal_inverses_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x +\<^sub>\<real> (-\<^sub>\<real> x) = 0\<^sub>\<real>"
	proof-
	have "x' + (-x') = 0" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Multiplication: Definition 2.2.1.e.\<close>

	lemma vreal_assoc_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "(x \<^sub>\<real> y) \<^sub>\<real> z = x \<^sub>\<real> (y \<^sub>\<real> z)"
	proof-
	have "(x' * y') * z' = x' * (y' * z')" for x' y' z' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Multiplication: Definition 2.2.1.f.\<close>

	lemma vreal_commutative_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x \<^sub>\<real> y = y \<^sub>\<real> x"
	proof-
	have "(x' * y') = y' * x' " for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for Multiplication: Definition 2.2.1.g.\<close>

	lemma vreal_identity_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x *\<^sub>\<real> 1\<^sub>\<real> = x"
	proof-
	have "x' * 1 = x'" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Inverses Law for Multiplication: Definition 2.2.1.h.\<close>

	lemma vreal_inverses_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "x \<noteq> 0\<^sub>\<real>"
	shows "x *\<^sub>\<real> x\<inverse>\<^sub>\<real> = 1\<^sub>\<real>"
	proof-
	have "x' \<noteq> 0 \<Longrightarrow> x' * inverse x' = 1" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Distributive Law: Definition 2.2.1.i.\<close>

	lemma vreal_distributive_law:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x \<^sub>\<real> (y +\<^sub>\<real> z) = x \<^sub>\<real> y +\<^sub>\<real> x *\<^sub>\<real> z"
	proof-
	have "x' * (y' + z') = (x' * y') + (x' * z')" for x' y' z' :: real
	by (simp add: field_simps)
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Trichotomy Law: Definition 2.2.1.j.\<close>

	lemma vreal_trichotomy_law:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows
	"(x <\<^sub>\<real> y \<and> ~(x = y) \<and> ~(y <\<^sub>\<real> x)) \<or>
	(~(x <\<^sub>\<real> y) \<and> x = y \<and> ~(y <\<^sub>\<real> x)) \<or>
	(~(x <\<^sub>\<real> y) \<and> ~(x = y) \<and> y <\<^sub>\<real> x)"
	proof-
	have "(x' < y' \<and> ~(x' = y') \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> x' = y' \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> ~(x' = y') \<and> y' < x')"
	for x' y' z' :: real
	by auto
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Transitive Law: Definition 2.2.1.k.\<close>

	lemma vreal_transitive_law:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "x <\<^sub>\<real> y" and "y <\<^sub>\<real> z"
	shows "x <\<^sub>\<real> z"
	proof-
	have "x' < y' \<Longrightarrow> y' < z' \<Longrightarrow> x' < z'" for x' y' z' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Addition Law of Order: Definition 2.2.1.l.\<close>

	lemma vreal_addition_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "x <\<^sub>\<real> y"
	shows "x +\<^sub>\<real> z <\<^sub>\<real> y +\<^sub>\<real> z"
	proof-
	have "x' < y' \<Longrightarrow> x' + z' < y' + z'" for x' y' z' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Multiplication Law of Order: Definition 2.2.1.m.\<close>

	lemma vreal_multiplication_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "x <\<^sub>\<real> y"
	and "0\<^sub>\<real> <\<^sub>\<real> z"
	shows "x \<^sub>\<real> z <\<^sub>\<real> y \<^sub>\<real> z"
	proof-
	have "x' < y' \<Longrightarrow> 0 < z' \<Longrightarrow> x' * z' < y' * z'" for x' y' z' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Non-Triviality: Definition 2.2.1.n.\<close>

	lemma vreal_non_triviality: "0\<^sub>\<real> \<noteq> 1\<^sub>\<real>"
	proof-
	have "0 \<noteq> (1::real)" by simp
	from this[untransferred] show ?thesis.
	qed


	text\<open>Least upper bound property: Definition 2.2.3.\<close>

	lemma least_upper_bound_property:
	defines "vreal_ub S M \<equiv> (S \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ> \<and> M \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> \<and> (\<forall>x\<in>\<^sub>\<circ>S. x \<le>\<^sub>\<real> M))"
	assumes "A \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "A \<noteq> 0" and "\<exists>M. vreal_ub A M"
	obtains M where "vreal_ub A M" and "\<And>T. vreal_ub A T \<Longrightarrow> M \<le>\<^sub>\<real> T"
	proof-
	note complete_real =
	complete_real[
	untransferred, of \<open>elts A\<close>, unfolded vnumber_simps, OF assms(2)
	]
	from assms obtain x where "x \<in>\<^sub>\<circ> A" by force
	moreover with assms have "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by auto
	ultimately have 1: "\<exists>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ>. x \<in>\<^sub>\<circ> A" by auto
	from assms have 2: "\<exists>x\<in>\<^sub>\<circ>\<real>\<^sub>\<circ>. \<forall>y\<in>\<^sub>\<circ>A. y \<le>\<^sub>\<real> x" by auto
	from complete_real[OF 1 2]
	obtain M
	where "M \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<le>\<^sub>\<real> M"
	and [simp]: "\<And>T. T \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> \<Longrightarrow> (\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<le>\<^sub>\<real> T) \<Longrightarrow> M \<le>\<^sub>\<real> T"
	by force
	with assms(2) have "vreal_ub A M" unfolding vreal_ub_def by simp
	moreover have "vreal_ub A T \<Longrightarrow> M \<le>\<^sub>\<real> T" for T unfolding vreal_ub_def by simp
	ultimately show ?thesis using that by auto
	qed


	subsubsection\<open>Fundamental properties of other operations\<close>


	text\<open>Minus.\<close>

	lemma vreal_minus_closed:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x -\<^sub>\<real> y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof-
	have "x' - y' \<in> UNIV" for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vreal_minus_eq_plus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x -\<^sub>\<real> y = x +\<^sub>\<real> (-\<^sub>\<real> y)"
	proof-
	have "x' - y' = x' + (-y')" for x' y' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Unary minus.\<close>

	lemma vreal_uminus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x = -\<^sub>\<real> (-\<^sub>\<real> x)"
	proof-
	have "x' = -(-x')" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Multiplicative inverse.\<close>

	lemma vreal_inverse_inverse:
	assumes "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	shows "x = (x\<inverse>\<^sub>\<real>)\<inverse>\<^sub>\<real>"
	proof-
	have "x' = inverse (inverse x')" for x' :: real by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	subsubsection\<open>Further properties\<close>


	text\<open>Addition.\<close>

	global_interpretation vreal_plus: binop_onto \<open>\<real>\<^sub>\<circ>\<close> vreal_plus
	proof-
	have binop: "binop \<real>\<^sub>\<circ> vreal_plus"
	proof(intro binopI nopI)
	show vsv: "vsv vreal_plus" unfolding vreal_plus_def by auto
	interpret vsv vreal_plus by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vreal_plus = \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vreal_plus_def by simp
	show "\<R>\<^sub>\<circ> vreal_plus \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_plus"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vreal_plus\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by (simp add: vreal_plus_closed y_def)
	qed
	qed
	interpret binop \<open>\<real>\<^sub>\<circ>\<close> vreal_plus by (rule binop)
	show "binop_onto \<real>\<^sub>\<circ> vreal_plus"
	proof(intro binop_ontoI')
	show "binop \<real>\<^sub>\<circ> vreal_plus" by (rule binop_axioms)
	show "\<real>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_plus"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	moreover from vreal_zero vreal_zero_closed have "0 \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by auto
	ultimately have "y +\<^sub>\<real> 0 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_plus" by auto
	moreover from prems vreal_identity_law_addition have "y = y +\<^sub>\<real> 0"
	by (simp add: vreal_zero)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_plus" by simp
	qed
	qed
	qed


	text\<open>Unary minus.\<close>

	global_interpretation vreal_uminus: v11 vreal_uminus
	- rewrites "\<D>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>"
	- and "\<R>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>"
	+ rewrites vreal_uminus_vdomain[simp]: "\<D>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>"
	+ and vreal_uminus_vrange[simp]: "\<R>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>"
	proof-
	show v11: "v11 vreal_uminus"
	proof(intro v11I)
	show vsv: "vsv vreal_uminus" unfolding vreal_uminus_def by simp
	interpret vsv vreal_uminus by (rule vsv)
	show "vsv (vreal_uminus\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	show "vbrelation (vreal_uminus\<inverse>\<^sub>\<circ>)" by clarsimp
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vreal_uminus\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vreal_uminus\<inverse>\<^sub>\<circ>"
	then have ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> vreal_uminus" and ca: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> vreal_uminus"
	by auto
	then have b: "b \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	by (simp_all add: VLambda_iff2 vreal_uminus_def)
	from ba ca have "a = -\<^sub>\<real> b" "a = -\<^sub>\<real> c" by simp_all
	with ba ca b c show "b = c" by (metis vreal_uminus_uminus)
	qed
	qed
	interpret v11 vreal_uminus by (rule v11)
	show dom: "\<D>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>" unfolding vreal_uminus_def by simp
	have "\<R>\<^sub>\<circ> vreal_uminus \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_uminus"
	then obtain x where "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and y_def: "y = -\<^sub>\<real> x"
	unfolding dom[symmetric] by force
	then show "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by (simp add: vreal_uminus_closed)
	qed
	moreover have "\<real>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_uminus"
	by (intro vsubsetI)
	(metis dom vdomain_atD vreal_uminus_closed vreal_uminus_uminus)
	ultimately show "\<R>\<^sub>\<circ> vreal_uminus = \<real>\<^sub>\<circ>" by simp
	qed


	text\<open>Multiplication.\<close>

	global_interpretation vreal_mult: binop_onto \<open>\<real>\<^sub>\<circ>\<close> vreal_mult
	proof-
	have binop: "binop \<real>\<^sub>\<circ> vreal_mult"
	proof(intro binopI nopI)
	show vsv: "vsv vreal_mult" unfolding vreal_mult_def by auto
	interpret vsv vreal_mult by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vreal_mult = \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vreal_mult_def by simp
	show "\<R>\<^sub>\<circ> vreal_mult \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_mult"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<real>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vreal_mult\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by (simp add: vreal_mult_closed y_def)
	qed
	qed
	interpret binop \<open>\<real>\<^sub>\<circ>\<close> vreal_mult by (rule binop)
	show "binop_onto \<real>\<^sub>\<circ> vreal_mult"
	proof(intro binop_ontoI')
	show "binop \<real>\<^sub>\<circ> vreal_mult" by (rule binop_axioms)
	show "\<real>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_mult"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	moreover from vreal_one vreal_one_closed have "1 \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by auto
	ultimately have "y *\<^sub>\<real> 1 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_mult" by auto
	moreover from prems vreal_identity_law_multiplication have "y = y *\<^sub>\<real> 1"
	by (simp add: vreal_one)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_mult" by simp
	qed
	qed
	qed


	text\<open>Multiplicative inverse.\<close>

	global_interpretation vreal_inverse: v11 vreal_inverse
	- rewrites "\<D>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>"
	- and "\<R>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>"
	+ rewrites vreal_inverse_vdomain[simp]: "\<D>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>"
	+ and vreal_inverse_vrange[simp]: "\<R>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>"
	proof-
	show v11: "v11 vreal_inverse"
	proof(intro v11I)
	show vsv: "vsv vreal_inverse" unfolding vreal_inverse_def by simp
	interpret vsv vreal_inverse by (rule vsv)
	show "vsv (vreal_inverse\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	show "vbrelation (vreal_inverse\<inverse>\<^sub>\<circ>)" by clarsimp
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vreal_inverse\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vreal_inverse\<inverse>\<^sub>\<circ>"
	then have ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> vreal_inverse" and ca: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> vreal_inverse"
	by auto
	then have b: "b \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	by (simp_all add: VLambda_iff2 vreal_inverse_def)
	from ba ca have "a = b\<inverse>\<^sub>\<real>" "a = c\<inverse>\<^sub>\<real>" by simp_all
	with ba ca b c show "b = c" by (metis vreal_inverse_inverse)
	qed
	qed
	interpret v11 vreal_inverse by (rule v11)
	show dom: "\<D>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>" unfolding vreal_inverse_def by simp
	have "\<R>\<^sub>\<circ> vreal_inverse \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_inverse"
	then obtain x where "x \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" and y_def: "y = x\<inverse>\<^sub>\<real>"
	unfolding dom[symmetric] by force
	then show "y \<in>\<^sub>\<circ> \<real>\<^sub>\<circ>" by (simp add: vreal_inverse_closed)
	qed
	moreover have "\<real>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vreal_inverse"
	by (intro vsubsetI)
	(metis dom vdomain_atD vreal_inverse_closed vreal_inverse_inverse)
	ultimately show "\<R>\<^sub>\<circ> vreal_inverse = \<real>\<^sub>\<circ>" by simp
	qed



	subsection\<open>Integer numbers\<close>


	subsubsection\<open>Definition\<close>

	definition vint_of_int :: "int \<Rightarrow> V"
	where "vint_of_int = vreal_of_real"

	notation vint_of_int (\<open>_\<^sub>\<int>\<close> [999] 999)

	declare [[coercion "vint_of_int :: int \<Rightarrow> V"]]

	definition vint :: V (\<open>\<int>\<^sub>\<circ>\<close>)
	where "vint = set (range vint_of_int)"

	definition int_of_vint :: "V \<Rightarrow> int"
	where "int_of_vint = inv_into UNIV vint_of_int"


	text\<open>Rules.\<close>

	lemma vint_of_int_in_vintI[intro, simp]: "a\<^sub>\<int> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by (simp add: vint_def)

	lemma vint_of_int_in_vintE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	obtains b where "b\<^sub>\<int> = a"
	using assms unfolding vint_def by auto


	subsubsection\<open>Elementary properties\<close>

	lemma vint_vsubset_vreal: "\<int>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	unfolding vint_def vint_of_int_def vreal_def using image_cong by auto

	lemma inj_vint_of_int: "inj vint_of_int"
	using inj_vreal_of_real
	unfolding vint_of_int_def inj_def of_int_eq_iff
	by force

	lemma vint_in_Vset_\<omega>2: "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	using vint_vsubset_vreal vreal_in_Vset_\<omega>2 by auto

	lemma int_of_vint_vint_of_int[simp]: "int_of_vint (a\<^sub>\<int>) = a"
	by (simp add: inj_vint_of_int int_of_vint_def)


	text\<open>Transfer rules.\<close>

	definition cr_vint :: "V \<Rightarrow> int \<Rightarrow> bool"
	where "cr_vint a b \<longleftrightarrow> (a = vint_of_int b)"

	lemma cr_vint_right_total[transfer_rule]: "right_total cr_vint"
	unfolding cr_vint_def right_total_def by simp

	lemma cr_vint_bi_unqie[transfer_rule]: "bi_unique cr_vint"
	unfolding cr_vint_def bi_unique_def
	by (simp add: inj_eq inj_vint_of_int)

	lemma cr_vint_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_vint = (\<lambda>x. x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>)"
	unfolding cr_vint_def by force

	lemma vint_transfer[transfer_rule]:
	"(rel_set cr_vint) (elts \<int>\<^sub>\<circ>) (UNIV::int set)"
	unfolding cr_vint_def rel_set_def by auto

	lemma vint_of_int_transfer[transfer_rule]: "cr_vint (vint_of_int a) a"
	unfolding cr_vint_def by auto


	subsubsection\<open>Constants and operations\<close>


	text\<open>Auxiliary.\<close>

	lemma vint_fsingleton_in_fproduct_vint: "[a\<^sub>\<int>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 1\<^sub>\<nat>" by auto

	lemma vint_fpair_in_fproduct_vint: "[a\<^sub>\<int>, b\<^sub>\<int>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" by force


	text\<open>Zero.\<close>

	lemma vint_zero: "0\<^sub>\<int> = (0::V)" by (simp add: vint_of_int_def vreal_zero)


	text\<open>One.\<close>

	lemma vint_one: "1\<^sub>\<int> = (1::V)" by (simp add: vreal_one vint_of_int_def)


	text\<open>Addition.\<close>

	definition vint_plus :: V
	where "vint_plus =
	(\<lambda>x\<in>\<^sub>\<circ>\<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (int_of_vint (x\<lparr>0\<^sub>\<nat>\<rparr>) + int_of_vint (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<int>)"

	abbreviation vint_plus_app (infixl "+\<^sub>\<int>" 65)
	where "vint_plus_app a b \<equiv> vint_plus\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vint_plus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vint ===> cr_vint ===> cr_vint) (+\<^sub>\<int>) (+)"
	using vint_fpair_in_fproduct_vint
	by (intro rel_funI, unfold vint_plus_def cr_vint_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Multiplication.\<close>

	definition vint_mult :: V
	where "vint_mult =
	(\<lambda>x\<in>\<^sub>\<circ>\<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (int_of_vint (x\<lparr>0\<^sub>\<nat>\<rparr>) * int_of_vint (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<int>)"

	abbreviation vint_mult_app (infixl "*\<^sub>\<int>" 65)
	where "vint_mult_app a b \<equiv> vint_mult\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vint_mult_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vint ===> cr_vint ===> cr_vint) (\<^sub>\<int>) ()"
	using vint_fpair_in_fproduct_vint
	by (intro rel_funI, unfold vint_mult_def cr_vint_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Unary minus.\<close>

	definition vint_uminus :: V
	where "vint_uminus = (\<lambda>x\<in>\<^sub>\<circ>\<int>\<^sub>\<circ>. (uminus (int_of_vint x))\<^sub>\<int>)"

	abbreviation vint_uminus_app ("-\<^sub>\<int> _" [81] 80)
	where "-\<^sub>\<int> a \<equiv> vint_uminus\<lparr>a\<rparr>"

	lemma vint_uminus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vint ===> cr_vint) (vint_uminus_app) (uminus)"
	using vint_fsingleton_in_fproduct_vint
	by (intro rel_funI, unfold vint_uminus_def cr_vint_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Order.\<close>

	definition vint_le :: V
	where "vint_le =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> int_of_vint a \<le> int_of_vint b}"

	abbreviation vint_le' ("(_/ \<le>\<^sub>\<int> _)" [51, 51] 50)
	where "a \<le>\<^sub>\<int> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vint_le"

	lemma small_vint_le[simp]:
	"small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> int_of_vint a \<le> int_of_vint b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vint_le_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vint ===> cr_vint ===> (=)) vint_le' (\<le>)"
	using vint_fsingleton_in_fproduct_vint
	by (intro rel_funI, unfold cr_scalar_def cr_vint_def vint_le_def)
	(auto simp: nat_omega_simps)


	text\<open>Strict order.\<close>

	definition vint_ls :: V
	where "vint_ls =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> int_of_vint a < int_of_vint b}"

	abbreviation vint_ls' ("(_/ <\<^sub>\<int> _)" [51, 51] 50)
	where "a <\<^sub>\<int> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vint_ls"

	lemma small_vint_ls[simp]:
	"small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> int_of_vint a < int_of_vint b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vint_ls_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vint ===> cr_vint ===> (=)) vint_ls' (<)"
	using vint_fsingleton_in_fproduct_vint
	by (intro rel_funI, unfold cr_scalar_def cr_vint_def vint_ls_def)
	(auto simp: nat_omega_simps)


	text\<open>Subtraction.\<close>

	definition vint_minus :: V
	where "vint_minus =
	(\<lambda>x\<in>\<^sub>\<circ>\<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (int_of_vint (x\<lparr>0\<^sub>\<nat>\<rparr>) - int_of_vint (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<int>)"

	abbreviation vint_minus_app (infixl "-\<^sub>\<int>" 65)
	where "vint_minus_app a b \<equiv> vint_minus\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vint_minus_transfer[transfer_rule]:
	includes lifting_syntax
	- shows "(cr_vint ===> cr_vint ===> cr_vint)
	- (-\<^sub>\<int>) (-)"
	+ shows "(cr_vint ===> cr_vint ===> cr_vint) (-\<^sub>\<int>) (-)"
	using vint_fpair_in_fproduct_vint
	by (intro rel_funI, unfold vint_minus_def cr_vint_def cr_scalar_def)
	(simp add: nat_omega_simps)


	subsubsection\<open>Axioms of a well ordered integral domain\<close>


	text\<open>The exposition follows Definition 1.4.1 from the textbook
	\<open>The Real Numbers and Real Analysis\<close> by E. Bloch
	\cite{bloch_real_2010}.\<close>

	lemma vint_zero_closed: "0\<^sub>\<int> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by auto

	lemma vint_one_closed: "1\<^sub>\<int> \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by auto

	lemma vint_plus_closed:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x +\<^sub>\<int> y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof-
	have "x' + y' \<in> UNIV" for x' y' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vint_mult_closed:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x *\<^sub>\<int> y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof-
	have "(x'::int) * y' \<in> UNIV" for x' y' by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vint_uminus_closed:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "-\<^sub>\<int> x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof-
	have "(-x'::int) \<in> UNIV" for x' by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Addition: Definition 1.4.1.a.\<close>

	lemma vint_assoc_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "(x +\<^sub>\<int> y) +\<^sub>\<int> z = x +\<^sub>\<int> (y +\<^sub>\<int> z)"
	proof-
	have "(x' + y') + z' = x' + (y' + z')" for x' y' z' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Addition: Definition 1.4.1.b.\<close>

	lemma vint_commutative_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x +\<^sub>\<int> y = y +\<^sub>\<int> x"
	proof-
	have "x' + y' = y' + x'" for x' y' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for Addition: Definition 1.4.1.c.\<close>

	lemma vint_identity_law_addition:
	assumes [simp]: "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x +\<^sub>\<int> 0\<^sub>\<int> = x"
	proof-
	have "x' + 0 = x'" for x' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Inverses Law for Addition: Definition 1.4.1.d.\<close>

	lemma vint_inverses_law_addition:
	assumes [simp]: "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x +\<^sub>\<int> (-\<^sub>\<int> x) = 0\<^sub>\<int>"
	proof-
	have "x' + (-x') = 0" for x' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Multiplication: Definition 1.4.1.e.\<close>

	lemma vint_assoc_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "(x \<^sub>\<int> y) \<^sub>\<int> z = x \<^sub>\<int> (y \<^sub>\<int> z)"
	proof-
	have "(x' * y') * z' = x' * (y' * z')" for x' y' z' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Multiplication: Definition 1.4.1.f.\<close>

	lemma vint_commutative_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x \<^sub>\<int> y = y \<^sub>\<int> x"
	proof-
	have "x' * y' = y' * x'" for x' y' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for multiplication: Definition 1.4.1.g.\<close>

	lemma vint_identity_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x *\<^sub>\<int> 1\<^sub>\<int> = x"
	proof-
	have "x' * 1 = x'" for x' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Distributive Law for Multiplication: Definition 1.4.1.h.\<close>

	lemma vint_distributive_law:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x \<^sub>\<int> (y +\<^sub>\<int> z) = (x \<^sub>\<int> y) +\<^sub>\<int> (x *\<^sub>\<int> z)"
	proof-
	have "x' * (y' + z') = (x' * y') + (x' * z')" for x' y' z' :: int
	by (simp add: algebra_simps)
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>No Zero Divisors Law: Definition 1.4.1.i.\<close>

	lemma vint_no_zero_divisors_law:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "x *\<^sub>\<int> y = 0\<^sub>\<int>"
	shows "x = 0\<^sub>\<int> \<or> y = 0\<^sub>\<int>"
	proof-
	have "x' * y' = 0 \<Longrightarrow> x' = 0 \<or> y' = 0" for x' y' z' :: int
	by (simp add: algebra_simps)
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Trichotomy Law: Definition 1.4.1.j\<close>

	lemma vint_trichotomy_law:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows
	"(x <\<^sub>\<int> y \<and> ~(x = y) \<and> ~(y <\<^sub>\<int> x)) \<or>
	(~(x <\<^sub>\<int> y) \<and> x = y \<and> ~(y <\<^sub>\<int> x)) \<or>
	(~(x <\<^sub>\<int> y) \<and> ~(x = y) \<and> y <\<^sub>\<int> x)"
	proof-
	have
	"(x' < y' \<and> ~(x' = y') \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> x' = y' \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> ~(x' = y') \<and> y' < x')"
	for x' y' z' :: int
	by auto
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Transitive Law: Definition 1.4.1.k\<close>

	lemma vint_transitive_law:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "x <\<^sub>\<int> y"
	and "y <\<^sub>\<int> z"
	shows "x <\<^sub>\<int> z"
	proof-
	have "x' < y' \<Longrightarrow> y' < z' \<Longrightarrow> x' < z'" for x' y' z' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Addition Law of Order: Definition 1.4.1.l\<close>

	lemma vint_addition_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "x <\<^sub>\<int> y"
	shows "x +\<^sub>\<int> z <\<^sub>\<int> y +\<^sub>\<int> z"
	proof-
	have "x' < y' \<Longrightarrow> x' + z' < y' + z'" for x' y' z' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Multiplication Law of Order: Definition 1.4.1.m\<close>

	lemma vint_multiplication_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "x <\<^sub>\<int> y"
	and "0\<^sub>\<int> <\<^sub>\<int> z"
	shows "x \<^sub>\<int> z <\<^sub>\<int> y \<^sub>\<int> z"
	proof-
	have "x' < y' \<Longrightarrow> 0 < z' \<Longrightarrow> x' * z' < y' * z'" for x' y' z' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Non-Triviality: Definition 1.4.1.n\<close>

	lemma vint_non_triviality: "0\<^sub>\<int> \<noteq> 1\<^sub>\<int>"
	proof-
	have "0 \<noteq> (1::int)" by simp
	from this[untransferred] show ?thesis.
	qed


	text\<open>Well-Ordering Principle.\<close>

	lemma well_ordering_principle:
	assumes "A \<subseteq>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "a \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "A \<noteq> 0"
	and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> a <\<^sub>\<int> x"
	obtains b where "b \<in>\<^sub>\<circ> A" and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> b \<le>\<^sub>\<int> x"
	proof-
	{
	fix A' and a' :: int assume prems: "A' \<noteq> {}" "x \<in> A' \<Longrightarrow> a' < x" for x
	then obtain a'' where a'': "a'' \<in> A'" by auto
	from wfE_min[OF wf_int_ge_less_than[of a'], OF a''] obtain b'
	where b'_A': "b' \<in> A'"
	and yb': "(y, b') \<in> int_ge_less_than a' \<Longrightarrow> y \<notin> A'"
	for y
	by auto
	moreover from prems b'_A' yb' have "\<And>x. x \<in> A' \<Longrightarrow> b' \<le> x"
	unfolding int_ge_less_than_def by fastforce
	with b'_A' have "\<exists>b. b \<in> A' \<and> (\<forall>x. x \<in> A' \<longrightarrow> b \<le> x)" by blast
	}
	note real_wo = this
	from real_wo[
	untransferred, of \<open>elts A\<close>, unfolded vnumber_simps, OF assms(1,2)
	]
	obtain b
	where "b \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	and "b \<in>\<^sub>\<circ> A"
	and "\<And>x. x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> \<Longrightarrow> x \<in>\<^sub>\<circ> A \<Longrightarrow> b \<le>\<^sub>\<int> x"
	by (auto simp: assms(3,4))
	with assms that show ?thesis unfolding vsubset_iff by simp
	qed


	subsubsection\<open>Fundamental properties of other operations\<close>


	text\<open>Minus.\<close>

	lemma vint_minus_closed:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x -\<^sub>\<int> y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof-
	have "x' - y' \<in> UNIV" for x' y' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vint_minus_eq_plus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x -\<^sub>\<int> y = x +\<^sub>\<int> (-\<^sub>\<int> y)"
	proof-
	have "x' - y' = x' + (-y')" for x' y' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Unary minus.\<close>

	lemma vint_uminus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	shows "x = -\<^sub>\<int> (-\<^sub>\<int> x)"
	proof-
	have "x' = -(-x')" for x' :: int by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	subsubsection\<open>Further properties\<close>


	text\<open>Addition.\<close>

	global_interpretation vint_plus: binop_onto \<open>\<int>\<^sub>\<circ>\<close> vint_plus
	proof-
	have binop: "binop \<int>\<^sub>\<circ> vint_plus"
	proof(intro binopI nopI)
	show vsv: "vsv vint_plus" unfolding vint_plus_def by auto
	interpret vsv vint_plus by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vint_plus = \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vint_plus_def by simp
	show "\<R>\<^sub>\<circ> vint_plus \<subseteq>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_plus"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vint_plus\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by (simp add: vint_plus_closed y_def)
	qed
	qed
	interpret binop \<open>\<int>\<^sub>\<circ>\<close> vint_plus by (rule binop)
	show "binop_onto \<int>\<^sub>\<circ> vint_plus"
	proof(intro binop_ontoI')
	show "binop \<int>\<^sub>\<circ> vint_plus" by (rule binop_axioms)
	show "\<int>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_plus"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	moreover from vint_zero vint_zero_closed have "0 \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by auto
	ultimately have "y +\<^sub>\<int> 0 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_plus" by auto
	moreover from prems vint_identity_law_addition have "y = y +\<^sub>\<int> 0"
	by (simp add: vint_zero)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_plus" by simp
	qed
	qed
	qed


	text\<open>Unary minus.\<close>

	global_interpretation vint_uminus: v11 vint_uminus
	- rewrites "\<D>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>"
	- and "\<R>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>"
	+ rewrites vint_uminus_vdomain[simp]: "\<D>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>"
	+ and vint_uminus_vrange[simp]: "\<R>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>"
	proof-
	show v11: "v11 vint_uminus"
	proof(intro v11I)
	show vsv: "vsv vint_uminus" unfolding vint_uminus_def by simp
	interpret vsv vint_uminus by (rule vsv)
	show "vsv (vint_uminus\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	show "vbrelation (vint_uminus\<inverse>\<^sub>\<circ>)" by clarsimp
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vint_uminus\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vint_uminus\<inverse>\<^sub>\<circ>"
	then have ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> vint_uminus" and ca: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> vint_uminus"
	by auto
	then have b: "b \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	by (simp_all add: VLambda_iff2 vint_uminus_def)
	from ba ca have "a = -\<^sub>\<int> b" "a = -\<^sub>\<int> c" by simp_all
	with ba ca b c show "b = c" by (metis vint_uminus_uminus)
	qed
	qed
	interpret v11 vint_uminus by (rule v11)
	show dom: "\<D>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>" unfolding vint_uminus_def by simp
	have "\<R>\<^sub>\<circ> vint_uminus \<subseteq>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_uminus"
	then obtain x where "x \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and y_def: "y = -\<^sub>\<int> x"
	unfolding dom[symmetric] by force
	then show "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by (simp add: vint_uminus_closed)
	qed
	moreover have "\<int>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_uminus"
	by (intro vsubsetI)
	(metis dom vdomain_atD vint_uminus_closed vint_uminus_uminus)
	ultimately show "\<R>\<^sub>\<circ> vint_uminus = \<int>\<^sub>\<circ>" by simp
	qed


	text\<open>Multiplication.\<close>

	global_interpretation vint_mult: binop_onto \<open>\<int>\<^sub>\<circ>\<close> vint_mult
	proof-
	have binop: "binop \<int>\<^sub>\<circ> vint_mult"
	proof(intro binopI nopI)
	show vsv: "vsv vint_mult" unfolding vint_mult_def by auto
	interpret vsv vint_mult by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vint_mult = \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vint_mult_def by simp
	show "\<R>\<^sub>\<circ> vint_mult \<subseteq>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_mult"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<int>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vint_mult\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by (simp add: vint_mult_closed y_def)
	qed
	qed
	interpret binop \<open>\<int>\<^sub>\<circ>\<close> vint_mult by (rule binop)
	show "binop_onto \<int>\<^sub>\<circ> vint_mult"
	proof(intro binop_ontoI')
	show "binop \<int>\<^sub>\<circ> vint_mult" by (rule binop_axioms)
	show "\<int>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_mult"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>"
	moreover from vint_one vint_one_closed have 0: "1 \<in>\<^sub>\<circ> \<int>\<^sub>\<circ>" by auto
	ultimately have "y *\<^sub>\<int> 1 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_mult" by auto
	moreover from prems vint_identity_law_multiplication have "y = y *\<^sub>\<int> 1"
	by (simp add: vint_one)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vint_mult" by simp
	qed
	qed
	qed


	+text\<open>Misc.\<close>
	+
	+lemma (in \<Z>) vint_in_Vset[intro]: "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ using vint_in_Vset_\<omega>2 vsubsetD by (auto intro!: \<Z>_Vset_\<omega>2_vsubset_Vset)
	+
	+

	subsection\<open>Rational numbers\<close>


	subsubsection\<open>Definition\<close>

	definition vrat_of_rat :: "rat \<Rightarrow> V"
	where "vrat_of_rat x = vreal_of_real (real_of_rat x)"

	notation vrat_of_rat (\<open>_\<^sub>\<rat>\<close> [999] 999)

	declare [[coercion "vrat_of_rat :: rat \<Rightarrow> V"]]

	definition vrat :: V (\<open>\<rat>\<^sub>\<circ>\<close>)
	where "vrat = set (range vrat_of_rat)"

	definition rat_of_vrat :: "V \<Rightarrow> rat"
	where "rat_of_vrat = inv_into UNIV vrat_of_rat"


	text\<open>Rules.\<close>

	lemma vrat_of_rat_in_vratI[intro, simp]: "a\<^sub>\<rat> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by (simp add: vrat_def)

	lemma vrat_of_rat_in_vratE[elim]:
	assumes "a \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	obtains b where "b\<^sub>\<rat> = a"
	using assms unfolding vrat_def by auto


	subsubsection\<open>Elementary properties\<close>

	lemma vrat_vsubset_vreal: "\<rat>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<real>\<^sub>\<circ>"
	unfolding vrat_def vrat_of_rat_def vreal_def using image_cong by auto

	lemma vrat_in_Vset_\<omega>2: "\<rat>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset (\<omega> + \<omega>)"
	using vrat_vsubset_vreal vreal_in_Vset_\<omega>2 by auto

	lemma inj_vrat_of_rat: "inj vrat_of_rat"
	using inj_vreal_of_real
	unfolding vrat_of_rat_def inj_def of_rat_eq_iff
	by force

	lemma rat_of_vrat_vrat_of_rat[simp]: "rat_of_vrat (a\<^sub>\<rat>) = a"
	by (simp add: inj_vrat_of_rat rat_of_vrat_def)


	text\<open>Transfer rules.\<close>

	definition cr_vrat :: "V \<Rightarrow> rat \<Rightarrow> bool"
	where "cr_vrat a b \<longleftrightarrow> (a = vrat_of_rat b)"

	lemma cr_vrat_right_total[transfer_rule]: "right_total cr_vrat"
	unfolding cr_vrat_def right_total_def by simp

	lemma cr_vrat_bi_unqie[transfer_rule]: "bi_unique cr_vrat"
	unfolding cr_vrat_def bi_unique_def
	by (simp add: inj_eq inj_vrat_of_rat)

	lemma cr_vrat_transfer_domain_rule[transfer_domain_rule]:
	"Domainp cr_vrat = (\<lambda>x. x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>)"
	unfolding cr_vrat_def by force

	lemma vrat_transfer[transfer_rule]:
	"(rel_set cr_vrat) (elts \<rat>\<^sub>\<circ>) (UNIV::rat set)"
	unfolding cr_vrat_def rel_set_def by auto

	lemma vrat_of_rat_transfer[transfer_rule]: "cr_vrat (vrat_of_rat a) a"
	unfolding cr_vrat_def by auto


	subsubsection\<open>Operations\<close>

	lemma vrat_fsingleton_in_fproduct_vrat: "[a\<^sub>\<rat>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 1\<^sub>\<nat>" by auto

	lemma vrat_fpair_in_fproduct_vrat: "[a\<^sub>\<rat>, b\<^sub>\<rat>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" by force


	text\<open>Zero.\<close>

	lemma vrat_zero: "0\<^sub>\<rat> = (0::V)" by (simp add: vrat_of_rat_def vreal_zero)


	text\<open>One.\<close>

	lemma vrat_one: "1\<^sub>\<rat> = (1::V)" by (simp add: vreal_one vrat_of_rat_def)


	text\<open>Addition.\<close>

	definition vrat_plus :: V
	where "vrat_plus =
	(\<lambda>x\<in>\<^sub>\<circ>\<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (rat_of_vrat (x\<lparr>0\<^sub>\<nat>\<rparr>) + rat_of_vrat (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<rat>)"

	abbreviation vrat_plus_app (infixl "+\<^sub>\<rat>" 65)
	where "vrat_plus_app a b \<equiv> vrat_plus\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vrat_plus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat ===> cr_vrat) (+\<^sub>\<rat>) (+)"
	using vrat_fpair_in_fproduct_vrat
	by (intro rel_funI, unfold vrat_plus_def cr_vrat_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Multiplication.\<close>

	definition vrat_mult :: V
	where "vrat_mult =
	(\<lambda>x\<in>\<^sub>\<circ>\<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (rat_of_vrat (x\<lparr>0\<^sub>\<nat>\<rparr>) * rat_of_vrat (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<rat>)"

	abbreviation vrat_mult_app (infixl "*\<^sub>\<rat>" 65)
	where "vrat_mult_app a b \<equiv> vrat_mult\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vrat_mult_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat ===> cr_vrat) (\<^sub>\<rat>) ()"
	using vrat_fpair_in_fproduct_vrat
	by (intro rel_funI, unfold vrat_mult_def cr_vrat_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Unary minus.\<close>

	definition vrat_uminus :: V
	where "vrat_uminus = (\<lambda>x\<in>\<^sub>\<circ>\<rat>\<^sub>\<circ>. (uminus (rat_of_vrat x))\<^sub>\<rat>)"

	abbreviation vrat_uminus_app ("-\<^sub>\<rat> _" [81] 80)
	where "-\<^sub>\<rat> a \<equiv> vrat_uminus\<lparr>a\<rparr>"

	lemma vrat_uminus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat) (vrat_uminus_app) (uminus)"
	using vrat_fsingleton_in_fproduct_vrat
	by (intro rel_funI, unfold vrat_uminus_def cr_vrat_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Multiplicative inverse.\<close>

	definition vrat_inverse :: V
	where "vrat_inverse = (\<lambda>x\<in>\<^sub>\<circ>\<rat>\<^sub>\<circ>. (inverse (rat_of_vrat x))\<^sub>\<rat>)"

	abbreviation vrat_inverse_app ("(_\<inverse>\<^sub>\<rat>)" [1000] 999)
	where "a\<inverse>\<^sub>\<rat> \<equiv> vrat_inverse\<lparr>a\<rparr>"

	lemma vrat_inverse_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat) (vrat_inverse_app) (inverse)"
	using vrat_fsingleton_in_fproduct_vrat
	by (intro rel_funI, unfold vrat_inverse_def cr_vrat_def cr_scalar_def)
	(simp add: nat_omega_simps)


	text\<open>Order.\<close>

	definition vrat_le :: V
	where "vrat_le =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> rat_of_vrat a \<le> rat_of_vrat b}"

	abbreviation vrat_le' ("(_/ \<le>\<^sub>\<rat> _)" [51, 51] 50)
	where "a \<le>\<^sub>\<rat> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vrat_le"

	lemma small_vrat_le[simp]:
	"small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> rat_of_vrat a \<le> rat_of_vrat b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vrat_le_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat ===> (=)) vrat_le' (\<le>)"
	using vrat_fsingleton_in_fproduct_vrat
	by (intro rel_funI, unfold cr_scalar_def cr_vrat_def vrat_le_def)
	(auto simp: nat_omega_simps)


	text\<open>Strict order.\<close>

	definition vrat_ls :: V
	where "vrat_ls =
	set {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> rat_of_vrat a < rat_of_vrat b}"

	abbreviation vrat_ls' ("(_/ <\<^sub>\<rat> _)" [51, 51] 50)
	where "a <\<^sub>\<rat> b \<equiv> [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> vrat_ls"

	lemma small_vrat_ls[simp]:
	"small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat> \<and> rat_of_vrat a < rat_of_vrat b}"
	proof-
	have small: "small {[a, b]\<^sub>\<circ> \| a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>}" by simp
	show ?thesis by (rule smaller_than_small[OF small]) auto
	qed

	lemma vrat_ls_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat ===> (=)) vrat_ls' (<)"
	by (intro rel_funI, unfold cr_scalar_def cr_vrat_def vrat_ls_def)
	(auto simp: nat_omega_simps)


	text\<open>Subtraction.\<close>

	definition vrat_minus :: V
	where "vrat_minus =
	(\<lambda>x\<in>\<^sub>\<circ>\<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>. (rat_of_vrat (x\<lparr>0\<^sub>\<nat>\<rparr>) - rat_of_vrat (x\<lparr>1\<^sub>\<nat>\<rparr>))\<^sub>\<rat>)"

	abbreviation vrat_minus_app (infixl "-\<^sub>\<rat>" 65)
	where "vrat_minus_app a b \<equiv> vrat_minus\<lparr>a, b\<rparr>\<^sub>\<bullet>"

	lemma vrat_minus_transfer[transfer_rule]:
	includes lifting_syntax
	shows "(cr_vrat ===> cr_vrat ===> cr_vrat)
	(-\<^sub>\<rat>) (-)"
	using vrat_fpair_in_fproduct_vrat
	by (intro rel_funI, unfold vrat_minus_def cr_vrat_def cr_scalar_def)
	(simp add: nat_omega_simps)


	subsubsection\<open>Axioms of an ordered field\<close>


	text\<open>The exposition follows Theorem 1.5.5 from the textbook
	\<open>The Real Numbers and Real Analysis\<close> by E. Bloch
	\cite{bloch_real_2010}.\<close>

	lemma vrat_zero_closed: "0\<^sub>\<rat> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by auto

	lemma vrat_one_closed: "1\<^sub>\<rat> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by auto

	lemma vrat_plus_closed:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x +\<^sub>\<rat> y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof-
	have "x' + y' \<in> UNIV" for x' y' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vrat_mult_closed:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x *\<^sub>\<rat> y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof-
	have "(x'::rat) * y' \<in> UNIV" for x' y' by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vrat_uminus_closed:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "-\<^sub>\<rat> x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof-
	have "(-x'::rat) \<in> UNIV" for x' by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vrat_inverse_closed:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x\<inverse>\<^sub>\<rat> \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof-
	have "inverse (x'::rat) \<in> UNIV" for x' by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Addition: Theorem 1.5.5.1.\<close>

	lemma vrat_assoc_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "(x +\<^sub>\<rat> y) +\<^sub>\<rat> z = x +\<^sub>\<rat> (y +\<^sub>\<rat> z)"
	proof-
	have "(x' + y') + z' = x' + (y' + z')" for x' y' z' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Addition: Theorem 1.5.5.2.\<close>

	lemma vrat_commutative_law_addition:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x +\<^sub>\<rat> y = y +\<^sub>\<rat> x"
	proof-
	have "x' + y' = y' + x'" for x' y' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for Addition: Theorem 1.5.5.3.\<close>

	lemma vrat_identity_law_addition:
	assumes [simp]: "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x +\<^sub>\<rat> 0\<^sub>\<rat> = x"
	proof-
	have "x' + 0 = x'" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Inverses Law for Addition: Theorem 1.5.5.4.\<close>

	lemma vrat_inverses_law_addition:
	assumes [simp]: "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x +\<^sub>\<rat> (-\<^sub>\<rat> x) = 0\<^sub>\<rat>"
	proof-
	have "x' + (-x') = 0" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Associative Law for Multiplication: Theorem 1.5.5.5.\<close>

	lemma vrat_assoc_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "(x \<^sub>\<rat> y) \<^sub>\<rat> z = x \<^sub>\<rat> (y \<^sub>\<rat> z)"
	proof-
	have "(x' * y') * z' = x' * (y' * z')" for x' y' z' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Commutative Law for Multiplication: Theorem 1.5.5.6.\<close>

	lemma vrat_commutative_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x \<^sub>\<rat> y = y \<^sub>\<rat> x"
	proof-
	have "x' * y' = y' * x'" for x' y' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Identity Law for multiplication: Theorem 1.5.5.7.\<close>

	lemma vrat_identity_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x *\<^sub>\<rat> 1\<^sub>\<rat> = x"
	proof-
	have "x' * 1 = x'" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Inverses Law for Multiplication: Definition 2.2.1.8.\<close>

	lemma vrat_inverses_law_multiplication:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "x \<noteq> 0\<^sub>\<rat>"
	shows "x *\<^sub>\<rat> x\<inverse>\<^sub>\<rat> = 1\<^sub>\<rat>"
	proof-
	have "x' \<noteq> 0 \<Longrightarrow> x' * inverse x' = 1" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Distributive Law for Multiplication: Theorem 1.5.5.9.\<close>

	lemma vrat_distributive_law:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x \<^sub>\<rat> (y +\<^sub>\<rat> z) = (x \<^sub>\<rat> y) +\<^sub>\<rat> (x *\<^sub>\<rat> z)"
	proof-
	have "x' * (y' + z') = (x' * y') + (x' * z')" for x' y' z' :: rat
	by (simp add: algebra_simps)
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Trichotomy Law: Theorem 1.5.5.10.\<close>

	lemma vrat_trichotomy_law:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows
	"(x <\<^sub>\<rat> y \<and> ~(x = y) \<and> ~(y <\<^sub>\<rat> x)) \<or>
	(~(x <\<^sub>\<rat> y) \<and> x = y \<and> ~(y <\<^sub>\<rat> x)) \<or>
	(~(x <\<^sub>\<rat> y) \<and> ~(x = y) \<and> y <\<^sub>\<rat> x)"
	proof-
	have
	"(x' < y' \<and> ~(x' = y') \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> x' = y' \<and> ~(y' < x')) \<or>
	(~(x' < y') \<and> ~(x' = y') \<and> y' < x')"
	for x' y' z' :: rat
	by auto
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Transitive Law: Theorem 1.5.5.11.\<close>

	lemma vrat_transitive_law:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "x <\<^sub>\<rat> y"
	and "y <\<^sub>\<rat> z"
	shows "x <\<^sub>\<rat> z"
	proof-
	have "x' < y' \<Longrightarrow> y' < z' \<Longrightarrow> x' < z'" for x' y' z' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Addition Law of Order: Theorem 1.5.5.12.\<close>

	lemma vrat_addition_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "x <\<^sub>\<rat> y"
	shows "x +\<^sub>\<rat> z <\<^sub>\<rat> y +\<^sub>\<rat> z"
	proof-
	have "x' < y' \<Longrightarrow> x' + z' < y' + z'" for x' y' z' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Multiplication Law of Order: Theorem 1.5.5.13.\<close>

	lemma vrat_multiplication_law_of_order:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "z \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	and "x <\<^sub>\<rat> y"
	and "0\<^sub>\<rat> <\<^sub>\<rat> z"
	shows "x \<^sub>\<rat> z <\<^sub>\<rat> y \<^sub>\<rat> z"
	proof-
	have "x' < y' \<Longrightarrow> 0 < z' \<Longrightarrow> x' * z' < y' * z'" for x' y' z' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Non-Triviality: Theorem 1.5.5.14.\<close>

	lemma vrat_non_triviality: "0\<^sub>\<rat> \<noteq> 1\<^sub>\<rat>"
	proof-
	have "0 \<noteq> (1::rat)" by simp
	from this[untransferred] show ?thesis.
	qed


	subsubsection\<open>Fundamental properties of other operations\<close>


	text\<open>Minus.\<close>

	lemma vrat_minus_closed:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x -\<^sub>\<rat> y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof-
	have "x' - y' \<in> UNIV" for x' y' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed

	lemma vrat_minus_eq_plus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x -\<^sub>\<rat> y = x +\<^sub>\<rat> (-\<^sub>\<rat> y)"
	proof-
	have "x' - y' = x' + (-y')" for x' y' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Unary minus.\<close>

	lemma vrat_uminus_uminus:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x = -\<^sub>\<rat> (-\<^sub>\<rat> x)"
	proof-
	have "x' = -(-x')" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	text\<open>Multiplicative inverse.\<close>

	lemma vrat_inverse_inverse:
	assumes "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	shows "x = (x\<inverse>\<^sub>\<rat>)\<inverse>\<^sub>\<rat>"
	proof-
	have "x' = inverse (inverse x')" for x' :: rat by simp
	from this[untransferred, OF assms] show ?thesis.
	qed


	subsubsection\<open>Further properties\<close>


	text\<open>Addition.\<close>

	global_interpretation vrat_plus: binop_onto \<open>\<rat>\<^sub>\<circ>\<close> vrat_plus
	proof-
	have binop: "binop \<rat>\<^sub>\<circ> vrat_plus"
	proof(intro binopI nopI)
	show vsv: "vsv vrat_plus" unfolding vrat_plus_def by auto
	interpret vsv vrat_plus by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vrat_plus = \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vrat_plus_def by simp
	show "\<R>\<^sub>\<circ> vrat_plus \<subseteq>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_plus"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vrat_plus\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by (simp add: vrat_plus_closed y_def)
	qed
	qed
	interpret binop \<open>\<rat>\<^sub>\<circ>\<close> vrat_plus by (rule binop)
	show "binop_onto \<rat>\<^sub>\<circ> vrat_plus"
	proof(intro binop_ontoI')
	show "binop \<rat>\<^sub>\<circ> vrat_plus" by (rule binop_axioms)
	show "\<rat>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_plus"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	moreover from vrat_zero vrat_zero_closed have 0: "0 \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	by auto
	ultimately have "y +\<^sub>\<rat> 0 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_plus" by auto
	moreover from prems vrat_identity_law_addition have "y = y +\<^sub>\<rat> 0"
	by (simp add: vrat_zero)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_plus" by simp
	qed
	qed
	qed


	text\<open>Unary minus.\<close>

	global_interpretation vrat_uminus: v11 vrat_uminus
	- rewrites "\<D>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>"
	- and "\<R>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>"
	+ rewrites vrat_uminus_vdomain[simp]: "\<D>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>"
	+ and vrat_uminus_vrange[simp]: "\<R>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>"
	proof-
	show v11: "v11 vrat_uminus"
	proof(intro v11I)
	show vsv: "vsv vrat_uminus" unfolding vrat_uminus_def by simp
	interpret vsv vrat_uminus by (rule vsv)
	show "vsv (vrat_uminus\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	show "vbrelation (vrat_uminus\<inverse>\<^sub>\<circ>)" by clarsimp
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vrat_uminus\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vrat_uminus\<inverse>\<^sub>\<circ>"
	then have ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> vrat_uminus" and ca: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> vrat_uminus"
	by auto
	then have b: "b \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	by (simp_all add: VLambda_iff2 vrat_uminus_def)
	from ba ca have "a = -\<^sub>\<rat> b" "a = -\<^sub>\<rat> c" by simp_all
	with ba ca b c show "b = c" by (metis vrat_uminus_uminus)
	qed
	qed
	interpret v11 vrat_uminus by (rule v11)
	show dom: "\<D>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>" unfolding vrat_uminus_def by simp
	have "\<R>\<^sub>\<circ> vrat_uminus \<subseteq>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_uminus"
	then obtain x where "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and y_def: "y = -\<^sub>\<rat> x"
	unfolding dom[symmetric] by force
	then show "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by (simp add: vrat_uminus_closed)
	qed
	moreover have "\<rat>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_uminus"
	by (intro vsubsetI)
	(metis dom vdomain_atD vrat_uminus_closed vrat_uminus_uminus)
	ultimately show "\<R>\<^sub>\<circ> vrat_uminus = \<rat>\<^sub>\<circ>" by simp
	qed


	text\<open>Multiplication.\<close>

	global_interpretation vrat_mult: binop_onto \<open>\<rat>\<^sub>\<circ>\<close> vrat_mult
	proof-
	have binop: "binop \<rat>\<^sub>\<circ> vrat_mult"
	proof(intro binopI nopI)
	show vsv: "vsv vrat_mult" unfolding vrat_mult_def by auto
	interpret vsv vrat_mult by (rule vsv)
	show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	show dom: "\<D>\<^sub>\<circ> vrat_mult = \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" unfolding vrat_mult_def by simp
	show "\<R>\<^sub>\<circ> vrat_mult \<subseteq>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_mult"
	then obtain ab where "ab \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ> ^\<^sub>\<times> 2\<^sub>\<nat>" and y_def: "y = vrat_mult\<lparr>ab\<rparr>"
	unfolding dom[symmetric] by force
	then obtain a b
	where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	by blast
	then show "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by (simp add: vrat_mult_closed y_def)
	qed
	qed
	interpret binop \<open>\<rat>\<^sub>\<circ>\<close> vrat_mult by (rule binop)
	show "binop_onto \<rat>\<^sub>\<circ> vrat_mult"
	proof(intro binop_ontoI')
	show "binop \<rat>\<^sub>\<circ> vrat_mult" by (rule binop_axioms)
	show "\<rat>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_mult"
	proof(intro vsubsetI)
	fix y assume prems: "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	moreover from vrat_one vrat_one_closed have "1 \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by auto
	ultimately have "y *\<^sub>\<rat> 1 \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_mult" by auto
	moreover from prems vrat_identity_law_multiplication have "y = y *\<^sub>\<rat> 1"
	by (simp add: vrat_one)
	ultimately show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_mult" by simp
	qed
	qed
	qed


	text\<open>Multiplicative inverse.\<close>

	global_interpretation vrat_inverse: v11 vrat_inverse
	- rewrites "\<D>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>"
	- and "\<R>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>"
	+ rewrites vrat_inverse_vdomain[simp]: "\<D>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>"
	+ and vrat_inverse_vrange[simp]: "\<R>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>"
	proof-
	show v11: "v11 vrat_inverse"
	proof(intro v11I)
	show vsv: "vsv vrat_inverse" unfolding vrat_inverse_def by simp
	interpret vsv vrat_inverse by (rule vsv)
	show "vsv (vrat_inverse\<inverse>\<^sub>\<circ>)"
	proof(intro vsvI)
	show "vbrelation (vrat_inverse\<inverse>\<^sub>\<circ>)" by clarsimp
	fix a b c
	assume prems: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> vrat_inverse\<inverse>\<^sub>\<circ>" "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> vrat_inverse\<inverse>\<^sub>\<circ>"
	then have ba: "\<langle>b, a\<rangle> \<in>\<^sub>\<circ> vrat_inverse" and ca: "\<langle>c, a\<rangle> \<in>\<^sub>\<circ> vrat_inverse"
	by auto
	then have b: "b \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	by (simp_all add: VLambda_iff2 vrat_inverse_def)
	from ba ca have "a = b\<inverse>\<^sub>\<rat>" "a = c\<inverse>\<^sub>\<rat>" by simp_all
	with ba ca b c show "b = c" by (metis vrat_inverse_inverse)
	qed
	qed
	interpret v11 vrat_inverse by (rule v11)
	show dom: "\<D>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>" unfolding vrat_inverse_def by simp
	have "\<R>\<^sub>\<circ> vrat_inverse \<subseteq>\<^sub>\<circ> \<rat>\<^sub>\<circ>"
	proof(intro vsubsetI)
	fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_inverse"
	then obtain x where "x \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" and y_def: "y = x\<inverse>\<^sub>\<rat>"
	unfolding dom[symmetric] by force
	then show "y \<in>\<^sub>\<circ> \<rat>\<^sub>\<circ>" by (simp add: vrat_inverse_closed)
	qed
	moreover have "\<rat>\<^sub>\<circ> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> vrat_inverse"
	by (intro vsubsetI)
	(metis dom vdomain_atD vrat_inverse_closed vrat_inverse_inverse)
	ultimately show "\<R>\<^sub>\<circ> vrat_inverse = \<rat>\<^sub>\<circ>" by simp
	qed


	+text\<open>Misc.\<close>
	+
	+lemma (in \<Z>) vrat_in_Vset[intro]: "\<rat>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ using vrat_in_Vset_\<omega>2 vsubsetD by (auto intro!: \<Z>_Vset_\<omega>2_vsubset_Vset)
	+
	+

	subsection\<open>Upper bound on the cardinality of the continuum for \<^typ>\<open>V\<close>\<close>

	lemma inj_on_inv_vreal_of_real: "inj_on (inv vreal_of_real) (elts \<real>\<^sub>\<circ>)"
	by (intro inj_onI) (fastforce intro: inv_into_injective)

	lemma vreal_vlepoll_VPow_omega: "\<real>\<^sub>\<circ> \<lesssim>\<^sub>\<circ> VPow \<omega>"
	proof-
	have "elts \<real>\<^sub>\<circ> \<lesssim> (UNIV::real set)"
	unfolding lepoll_def by (auto intro: inj_on_inv_vreal_of_real)
	from vlepoll_VPow_omega_if_vreal_lepoll_real[OF this] show ?thesis by simp
	qed

	+lemma (in \<Z>) vreal_in_Vset[intro]: "\<real>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ using vreal_in_Vset_\<omega>2 vsubsetD by (auto intro!: \<Z>_Vset_\<omega>2_vsubset_Vset)
	+
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/czh_sets/ex/CZH_EX_Algebra.thy b/thys/CZH_Foundations/czh_sets/ex/CZH_EX_Algebra.thy
	--- a/thys/CZH_Foundations/czh_sets/ex/CZH_EX_Algebra.thy
	+++ b/thys/CZH_Foundations/czh_sets/ex/CZH_EX_Algebra.thy
	@@ -1,396 +1,395 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Example III: abstract algebra\<close>
	theory CZH_EX_Algebra
	imports CZH_EX_TS
	begin



	subsection\<open>Background\<close>


	text\<open>
	The section presents several examples of algebraic structures formalized
	in \<open>ZFC in HOL\<close>. The definitions were adopted (with amendments) from the
	main library of Isabelle/HOL.
	\<close>

	named_theorems sgrp_struct_field_simps

	lemmas [sgrp_struct_field_simps] = \<A>_def



	subsection\<open>Semigroup\<close>


	subsubsection\<open>Foundations\<close>

	definition mbinop where [sgrp_struct_field_simps]: "mbinop = 1\<^sub>\<nat>"

	locale \<Z>_sgrp_basis = \<Z>_vfsequence \<alpha> \<SS> + op: binop \<open>\<SS>\<lparr>\<A>\<rparr>\<close> \<open>\<SS>\<lparr>mbinop\<rparr>\<close>
	for \<alpha> \<SS> +
	assumes \<Z>_sgrp_length: "vcard \<SS> = 2\<^sub>\<nat>"
	- and \<Z>_sgrp_binop: "binop (\<SS>\<lparr>\<A>\<rparr>) (\<SS>\<lparr>mbinop\<rparr>)"

	abbreviation sgrp_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<odot>\<^sub>\<circ>\<index>\<close> 70)
	where "sgrp_app \<SS> a b \<equiv> \<SS>\<lparr>mbinop\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
	notation sgrp_app (infixl \<open>\<odot>\<^sub>\<circ>\<close> 70)


	text\<open>Rules.\<close>

	lemma \<Z>_sgrp_basisI[intro]:
	assumes "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 2\<^sub>\<nat>"
	and "binop (\<SS>\<lparr>\<A>\<rparr>) (\<SS>\<lparr>mbinop\<rparr>)"
	shows "\<Z>_sgrp_basis \<alpha> \<SS>"
	using assms unfolding \<Z>_sgrp_basis_def \<Z>_sgrp_basis_axioms_def by simp

	lemma \<Z>_sgrp_basisD[dest]:
	assumes "\<Z>_sgrp_basis \<alpha> \<SS>"
	shows "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 2\<^sub>\<nat>"
	and "binop (\<SS>\<lparr>\<A>\<rparr>) (\<SS>\<lparr>mbinop\<rparr>)"
	using assms unfolding \<Z>_sgrp_basis_def \<Z>_sgrp_basis_axioms_def by auto

	lemma \<Z>_sgrp_basisE[elim]:
	assumes "\<Z>_sgrp_basis \<alpha> \<SS>"
	shows "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 2\<^sub>\<nat>"
	and "binop (\<SS>\<lparr>\<A>\<rparr>) (\<SS>\<lparr>mbinop\<rparr>)"
	using assms unfolding \<Z>_sgrp_basis_def \<Z>_sgrp_basis_axioms_def by auto


	subsubsection\<open>Simple semigroup\<close>

	locale \<Z>_sgrp = \<Z>_sgrp_basis \<alpha> \<SS> for \<alpha> \<SS> +
	assumes \<Z>_sgrp_assoc:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"


	text\<open>Rules.\<close>

	lemma \<Z>_sgrpI[intro]:
	assumes "\<Z>_sgrp_basis \<alpha> \<SS>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	shows "\<Z>_sgrp \<alpha> \<SS>"
	using assms unfolding \<Z>_sgrp_def \<Z>_sgrp_axioms_def by simp

	lemma \<Z>_sgrpD[dest]:
	assumes "\<Z>_sgrp \<alpha> \<SS>"
	shows "\<Z>_sgrp_basis \<alpha> \<SS>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	using assms unfolding \<Z>_sgrp_def \<Z>_sgrp_axioms_def by simp_all

	lemma \<Z>_sgrpE[elim]:
	assumes "\<Z>_sgrp \<alpha> \<SS>"
	obtains "\<Z>_sgrp_basis \<alpha> \<SS>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	using assms by auto



	subsection\<open>Commutative semigroup\<close>

	locale \<Z>_csgrp = \<Z>_sgrp \<alpha> \<SS> for \<alpha> \<SS> +
	assumes \<Z>_csgrp_commutative:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow> a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b = b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> a"


	text\<open>Rules.\<close>

	lemma \<Z>_csgrpI[intro]:
	assumes "\<Z>_sgrp \<alpha> \<SS>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow> a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b = b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> a"
	shows "\<Z>_csgrp \<alpha> \<SS>"
	using assms unfolding \<Z>_csgrp_def \<Z>_csgrp_axioms_def by simp

	lemma \<Z>_csgrpD[dest]:
	assumes "\<Z>_csgrp \<alpha> \<SS>"
	shows "\<Z>_sgrp \<alpha> \<SS>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow> a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b = b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> a"
	using assms unfolding \<Z>_csgrp_def \<Z>_csgrp_axioms_def by simp_all

	lemma \<Z>_csgrpE[elim]:
	assumes "\<Z>_csgrp \<alpha> \<SS>"
	obtains "\<Z>_sgrp \<alpha> \<SS>"
	and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow> a \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b = b \<odot>\<^sub>\<circ>\<^bsub>\<SS>\<^esub> a"
	using assms by auto



	subsection\<open>Semiring\<close>


	subsubsection\<open>Foundations\<close>

	definition vplus :: V where [sgrp_struct_field_simps]: "vplus = 1\<^sub>\<nat>"
	definition vmult :: V where [sgrp_struct_field_simps]: "vmult = 2\<^sub>\<nat>"

	abbreviation vplus_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>+\<^sub>\<circ>\<index>\<close> 65)
	where "a +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b \<equiv> \<SS>\<lparr>vplus\<rparr>\<lparr>a,b\<rparr>\<^sub>\<bullet>"
	notation vplus_app (infixl \<open>+\<^sub>\<circ>\<index>\<close> 65)

	abbreviation vmult_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>*\<^sub>\<circ>\<index>\<close> 70)
	where "a *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b \<equiv> \<SS>\<lparr>vmult\<rparr>\<lparr>a,b\<rparr>\<^sub>\<bullet>"
	notation vmult_app (infixl \<open>*\<^sub>\<circ>\<index>\<close> 70)


	subsubsection\<open>Simple semiring\<close>

	locale \<Z>_srng = \<Z>_vfsequence \<alpha> \<SS> for \<alpha> \<SS> +
	assumes \<Z>_srng_length: "vcard \<SS> = 3\<^sub>\<nat>"
	and \<Z>_srng_\<Z>_csgrp_vplus: "\<Z>_csgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>"
	and \<Z>_srng_\<Z>_sgrp_vmult: "\<Z>_sgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>"
	and \<Z>_srng_distrib_right:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	and \<Z>_srng_distrib_left:
	"\<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (a *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	begin

	sublocale vplus: \<Z>_csgrp \<alpha> \<open>[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<close>
	rewrites "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<SS>\<lparr>\<A>\<rparr>"
	and "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<lparr>mbinop\<rparr> = \<SS>\<lparr>vplus\<rparr>"
	and "sgrp_app [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ> = vplus_app \<SS>"
	proof(rule \<Z>_srng_\<Z>_csgrp_vplus)
	show "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<SS>\<lparr>\<A>\<rparr>"
	and [simp]: "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<lparr>mbinop\<rparr> = \<SS>\<lparr>vplus\<rparr>"
	by (auto simp: \<A>_def mbinop_def nat_omega_simps)
	show "(\<odot>\<^sub>\<circ>\<^bsub>[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>\<^esub>) = (+\<^sub>\<circ>\<^bsub>\<SS>\<^esub>)" by simp
	qed

	sublocale vmult: \<Z>_sgrp \<alpha> \<open>[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<close>
	rewrites "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<SS>\<lparr>\<A>\<rparr>"
	and "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<lparr>mbinop\<rparr> = \<SS>\<lparr>vmult\<rparr>"
	and "sgrp_app [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ> = vmult_app \<SS>"
	proof(rule \<Z>_srng_\<Z>_sgrp_vmult)
	show "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<SS>\<lparr>\<A>\<rparr>"
	and [simp]: "[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<lparr>mbinop\<rparr> = \<SS>\<lparr>vmult\<rparr>"
	by (auto simp: \<A>_def mbinop_def nat_omega_simps)
	show "(\<odot>\<^sub>\<circ>\<^bsub>[\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>\<^esub>) = (*\<^sub>\<circ>\<^bsub>\<SS>\<^esub>)" by simp
	qed

	end


	text\<open>Rules.\<close>

	lemma \<Z>_srngI[intro]:
	assumes "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 3\<^sub>\<nat>"
	and "\<Z>_csgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>"
	and "\<Z>_sgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (a *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	shows "\<Z>_srng \<alpha> \<SS>"
	using assms unfolding \<Z>_srng_def \<Z>_srng_axioms_def by simp

	lemma \<Z>_srngD[dest]:
	assumes "\<Z>_srng \<alpha> \<SS>"
	shows "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 3\<^sub>\<nat>"
	and "\<Z>_csgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>"
	and "\<Z>_sgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (a *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	using assms unfolding \<Z>_srng_def \<Z>_srng_axioms_def by simp_all

	lemma \<Z>_srngE[elim]:
	assumes "\<Z>_srng \<alpha> \<SS>"
	obtains "\<Z>_vfsequence \<alpha> \<SS>"
	and "vcard \<SS> = 3\<^sub>\<nat>"
	and "\<Z>_csgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vplus\<rparr>]\<^sub>\<circ>"
	and "\<Z>_sgrp \<alpha> [\<SS>\<lparr>\<A>\<rparr>, \<SS>\<lparr>vmult\<rparr>]\<^sub>\<circ>"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	(a +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	and "\<And>a b c. \<lbrakk> a \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; b \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr>; c \<in>\<^sub>\<circ> \<SS>\<lparr>\<A>\<rparr> \<rbrakk> \<Longrightarrow>
	a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> (b +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c) = (a \<^sub>\<circ>\<^bsub>\<SS>\<^esub> b) +\<^sub>\<circ>\<^bsub>\<SS>\<^esub> (a *\<^sub>\<circ>\<^bsub>\<SS>\<^esub> c)"
	using assms unfolding \<Z>_srng_def \<Z>_srng_axioms_def by auto



	subsection\<open>Integer numbers form a semiring\<close>

	definition vint_struct :: V (\<open>\<SS>\<^sub>\<int>\<close>)
	where "vint_struct = [\<int>\<^sub>\<circ>, vint_plus, vint_mult]\<^sub>\<circ>"

	named_theorems vint_struct_simps

	lemma vint_struct_\<A>[vint_struct_simps]: "\<SS>\<^sub>\<int>\<lparr>\<A>\<rparr> = \<int>\<^sub>\<circ>"
	unfolding vint_struct_def by (auto simp: sgrp_struct_field_simps)

	lemma vint_struct_vplus[vint_struct_simps]: "\<SS>\<^sub>\<int>\<lparr>vplus\<rparr> = vint_plus"
	unfolding vint_struct_def
	by (simp add: sgrp_struct_field_simps nat_omega_simps)

	lemma vint_struct_vmult[vint_struct_simps]: "\<SS>\<^sub>\<int>\<lparr>vmult\<rparr> = vint_mult"
	unfolding vint_struct_def
	by (simp add: sgrp_struct_field_simps nat_omega_simps)

	context \<Z>
	begin

	lemma \<Z>_srng_vint: "\<Z>_srng \<alpha> \<SS>\<^sub>\<int>"
	proof(intro \<Z>_srngI, unfold vint_struct_simps)

	interpret \<SS>: vfsequence \<open>\<SS>\<^sub>\<int>\<close> unfolding vint_struct_def by simp

	show vint_struct: "\<Z>_vfsequence \<alpha> \<SS>\<^sub>\<int>"
	proof(intro \<Z>_vfsequenceI)
	show "vfsequence \<SS>\<^sub>\<int>" unfolding vint_struct_def by simp
	show "\<R>\<^sub>\<circ> \<SS>\<^sub>\<int> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vsubsetI)
	fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> \<SS>\<^sub>\<int>"
	then consider \<open>x = \<int>\<^sub>\<circ>\<close> \| \<open>x = vint_plus\<close> \| \<open>x = vint_mult\<close>
	unfolding vint_struct_def by fastforce
	then show "x \<in>\<^sub>\<circ> Vset \<alpha>"
	proof cases
	case 1 with \<Z>_Vset_\<omega>2_vsubset_Vset vint_in_Vset_\<omega>2 show ?thesis by auto
	next
	case 2
	have "\<D>\<^sub>\<circ> vint_plus \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_plus.nop_vdomain
	proof(rule Limit_vcpower_in_VsetI)
	from Axiom_of_Infinity show "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	from \<Z>_Vset_\<omega>2_vsubset_Vset show "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto intro: vint_in_Vset_\<omega>2)
	qed auto
	moreover from \<Z>_Vset_\<omega>2_vsubset_Vset have "\<R>\<^sub>\<circ> vint_plus \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_plus.nop_onto_vrange by (auto intro: vint_in_Vset_\<omega>2)
	ultimately show "x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding 2
	by (simp add: rel_VLambda.vbrelation_Limit_in_VsetI vint_plus_def)
	next
	case 3
	have "\<D>\<^sub>\<circ> vint_mult \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_mult.nop_vdomain
	proof(rule Limit_vcpower_in_VsetI)
	from Axiom_of_Infinity show "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	from \<Z>_Vset_\<omega>2_vsubset_Vset show "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto intro: vint_in_Vset_\<omega>2)
	qed auto
	moreover from \<Z>_Vset_\<omega>2_vsubset_Vset Axiom_of_Infinity have
	"\<R>\<^sub>\<circ> vint_mult \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_mult.nop_onto_vrange by (auto intro: vint_in_Vset_\<omega>2)
	ultimately show "x \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding 3
	by (simp add: rel_VLambda.vbrelation_Limit_in_VsetI vint_mult_def)
	qed
	qed
	qed (simp add: \<Z>_axioms)

	interpret vint_struct: \<Z>_vfsequence \<alpha> \<open>\<SS>\<^sub>\<int>\<close> by (rule vint_struct)

	show "vcard \<SS>\<^sub>\<int> = 3\<^sub>\<nat>"
	unfolding vint_struct_def by (simp add: nat_omega_simps)

	have [vint_struct_simps]:
	"[\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<int>\<^sub>\<circ>" "[\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ>\<lparr>mbinop\<rparr> = vint_plus"
	"[\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ>\<lparr>\<A>\<rparr> = \<int>\<^sub>\<circ>" "[\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ>\<lparr>mbinop\<rparr> = vint_mult"
	by (auto simp: sgrp_struct_field_simps nat_omega_simps)

	have [vint_struct_simps]:
	"sgrp_app [\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ> = (+\<^sub>\<int>)"
	"sgrp_app [\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ> = (*\<^sub>\<int>)"
	unfolding vint_struct_simps by simp_all

	show "\<Z>_csgrp \<alpha> [\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ>"
	proof(intro \<Z>_csgrpI, unfold vint_struct_simps)
	show "\<Z>_sgrp \<alpha> [\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ>"
	proof(intro \<Z>_sgrpI \<Z>_sgrp_basisI, unfold vint_struct_simps)
	show "\<Z>_vfsequence \<alpha> [\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ>"
	proof(intro \<Z>_vfsequenceI)
	show "\<R>\<^sub>\<circ> [\<int>\<^sub>\<circ>, vint_plus]\<^sub>\<circ> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vfsequence_vrange_vconsI)
	from \<Z>_Vset_\<omega>2_vsubset_Vset show [simp]: "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto intro: vint_in_Vset_\<omega>2)
	show "vint_plus \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	from Axiom_of_Infinity show "\<D>\<^sub>\<circ> vint_plus \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_plus.nop_vdomain
	by (intro Limit_vcpower_in_VsetI) auto
	from Axiom_of_Infinity show "\<R>\<^sub>\<circ> vint_plus \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_plus.nop_onto_vrange by auto
	qed (simp_all add: vint_plus_def)
	qed simp_all
	qed (simp_all add: \<Z>_axioms)
	qed
	(
	auto simp:
	nat_omega_simps
	vint_plus.binop_axioms
	vint_assoc_law_addition
	)
	qed (simp add: vint_commutative_law_addition)

	show "\<Z>_sgrp \<alpha> [\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ>"
	proof
	(
	intro \<Z>_sgrpI \<Z>_sgrp_basisI;
	(unfold vint_struct_simps \| tactic\<open>all_tac\<close>)
	)
	show "\<Z>_vfsequence \<alpha> [\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ>"
	proof(intro \<Z>_vfsequenceI; (unfold vint_struct_simps \| tactic\<open>all_tac\<close>))
	from \<Z>_axioms show "\<Z> \<alpha>" by simp
	show "\<R>\<^sub>\<circ> [\<int>\<^sub>\<circ>, vint_mult]\<^sub>\<circ> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
	proof(intro vfsequence_vrange_vconsI)
	from \<Z>_Vset_\<omega>2_vsubset_Vset show [simp]: "\<int>\<^sub>\<circ> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto intro: vint_in_Vset_\<omega>2)
	show "vint_mult \<in>\<^sub>\<circ> Vset \<alpha>"
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	from Axiom_of_Infinity show "\<D>\<^sub>\<circ> vint_mult \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_mult.nop_vdomain
	by (intro Limit_vcpower_in_VsetI) auto
	from Axiom_of_Infinity show "\<R>\<^sub>\<circ> vint_mult \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding vint_mult.nop_onto_vrange by auto
	qed (simp_all add: vint_mult_def)
	qed simp_all
	qed auto
	qed
	(
	auto simp:
	nat_omega_simps
	vint_mult.binop_axioms
	vint_assoc_law_multiplication
	)

	qed
	(
	auto simp:
	vint_commutative_law_multiplication
	vint_plus_closed
	vint_distributive_law
	)


	text\<open>Interpretation.\<close>

	interpretation vint: \<Z>_srng \<alpha> \<open>\<SS>\<^sub>\<int>\<close>
	rewrites "\<SS>\<^sub>\<int>\<lparr>\<A>\<rparr> = \<int>\<^sub>\<circ>"
	and "\<SS>\<^sub>\<int>\<lparr>vplus\<rparr> = vint_plus"
	and "\<SS>\<^sub>\<int>\<lparr>vmult\<rparr> = vint_mult"
	and "vplus_app (\<SS>\<^sub>\<int>) = vint_plus_app"
	and "vmult_app (\<SS>\<^sub>\<int>) = vint_mult_app"
	unfolding vint_struct_simps by (rule \<Z>_srng_vint) simp_all

	thm vint.vmult.\<Z>_sgrp_assoc
	thm vint.vplus.\<Z>_sgrp_assoc
	thm vint.\<Z>_srng_distrib_left

	end

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Foundations/document/root.bib b/thys/CZH_Foundations/document/root.bib
	--- a/thys/CZH_Foundations/document/root.bib
	+++ b/thys/CZH_Foundations/document/root.bib
	@@ -1,515 +1,543 @@
	@book{bloch_real_2010,
	address = {Heidelberg},
	title = {The {Real} {Numbers} and {Real} {Analysis}},
	isbn = {978-0-387-72176-7},
	publisher = {Springer Science + Business Media},
	author = {Bloch, Ethan D.},
	year = {2010},
	}
	@book{takeuti_introduction_1971,
	address = {Heidelberg},
	title = {Introduction to {Axiomatic} {Set} {Theory}},
	isbn = {0-387-05302-6},
	publisher = {Springer-Verlag},
	author = {Takeuti, Gaisi and Zaring, Wilson M.},
	year = {1971},
	}
	@book{bourbaki_elements_1970,
	title = {Elements of {Mathematics}, {Theory} of {Sets}},
	isbn = {978-3-540-22525-6},
	publisher = {Originally published as {\'E}l{\'e}ments de Math{\'e}matique Th{\'e}orie des Ensembles; Paris: N. Bourbaki. Reprint, Heidelberg: Springer-Verlag, 2004.},
	author = {Bourbaki, Nicolas},
	year = {1970},
	}
	@book{hungerford_algebra_2003,
	address = {New York},
	title = {Algebra},
	isbn = {978-0-387-90518-1},
	publisher = {Springer},
	author = {Hungerford, Thomas W.},
	year = {2003},
	}
	@book{kelley_general_1955,
	title = {General {Topology}},
	isbn = {978-0-486-81544-2},
	- publisher = {Originally published as General Topology; New York: Van Nostrand Reinhold Company. Reprint, New York: Dover Publications, 2017.},
	+ publisher = {Originally published as General Topology; New York, NY, USA: Van Nostrand Reinhold Company. Reprint, Mineola, NY, USA: Dover Publications, 2017},
	author = {Kelley, John L.},
	year = {1955},
	}
	+@incollection{berardi_locales_2004,
	+ address = {Heidelberg},
	+ title = {Locales and {Locale} {Expressions} in {Isabelle}/{Isar}},
	+ volume = {3085},
	+ isbn = {978-3-540-22164-7},
	+ booktitle = {Types for {Proofs} and {Programs}},
	+ publisher = {Springer},
	+ author = {Ballarin, Clemens},
	+ editor = {Berardi, Stefano and Coppo, Mario and Damiani, Ferruccio},
	+ year = {2004},
	+ pages = {34--50},
	+}
	@book{adamek_abstract_2006,
	title = {Abstract and {Concrete} {Categories} - {The} {Joy} of {Cats}},
	author = {Adamek, Jiri and Herrlich, Horst and Strecker, George},
	year = {2006},
	}
	@misc{noauthor_wikipedia_2001,
	title = {Wikipedia},
	url = {https://www.wikipedia.org/},
	year = {2001},
	}
	@misc{noauthor_encyclopedia_nodate,
	title = {Encyclopedia of {Mathematics}},
	url = {https://www.encyclopediaofmath.org/index.php/Main_Page},
	}
	@misc{noauthor_proofwiki_nodate,
	title = {{ProofWiki}},
	url = {https://proofwiki.org/wiki/Main_Page},
	}
	@article{paulson_hereditarily_2013,
	title = {The {Hereditarily} {Finite} {Sets}},
	journal = {Archive of Formal Proofs},
	author = {Paulson, Lawrence C.},
	year = {2013},
	}
	@book{mac_lane_categories_2010,
	address = {New York},
	edition = {2},
	series = {Graduate {Texts} in {Mathematics}},
	title = {Categories for the {Working} {Mathematician}},
	isbn = {978-1-4419-3123-8},
	number = {5},
	publisher = {Springer},
	author = {Mac Lane, Saunders},
	year = {2010},
	}
	@article{stark_category_2016,
	title = {Category {Theory} with {Adjunctions} and {Limits}},
	journal = {Archive of Formal Proofs},
	author = {Stark, Eugene W.},
	year = {2016},
	}
	@article{paulson_zermelo_2019,
	title = {Zermelo {Fraenkel} {Set} {Theory} in {Higher}-{Order} {Logic}},
	journal = {Archive of Formal Proofs},
	author = {Paulson, Lawrence C.},
	year = {2019},
	}
	@article{katovsky_category_2010,
	title = {Category {Theory}},
	journal = {Archive of Formal Proofs},
	author = {Katovsky, Alexander},
	year = {2010},
	}
	@article{okeefe_category_2005,
	title = {Category {Theory} to {Yoneda}'s {Lemma}},
	journal = {Archive of Formal Proofs},
	author = {O'Keefe, Greg},
	year = {2005},
	}
	@misc{noauthor_nlab_nodate,
	title = {{nLab}},
	url = {https://ncatlab.org/nlab/show/HomePage},
	}
	@book{bodo_categories_1970,
	address = {New York},
	title = {Categories and {Functors}},
	publisher = {Academic Press},
	author = {Bodo, Pareigis},
	year = {1970},
	}
	@article{mitchell_dominion_1972,
	title = {The {Dominion} of {Isbell}},
	volume = {167},
	journal = {Transactions of the American Mathematical Society},
	author = {Mitchell, Barry},
	year = {1972},
	}
	@inproceedings{brown_higher-order_2019,
	address = {Portland, USA},
	title = {Higher-{Order} {Tarski} {Grothendieck} as a {Foundation} for {Formal} {Proof}},
	booktitle = {10th {International} {Conference} on {Interactive} {Theorem} {Proving} ({ITP} 2019)},
	author = {Brown, Chad E. and Kaliszyk, Cezary and Pak, Karol},
	editor = {Harrison, John and O'Leary, John and Tolmach, Andrew},
	year = {2019},
	keywords = {000 Computer science, knowledge, general works, Computer Science},
	pages = {9:1--9:16},
	}
	@inproceedings{feferman_set-theoretical_1969,
	address = {Heidelberg},
	series = {Lecture {Notes} in {Mathematics}},
	title = {Set-{Theoretical} {Foundations} of {Category} {Theory}},
	booktitle = {Reports of the {Midwest} {Category} {Seminar} {III}},
	publisher = {Springer},
	author = {Feferman, Solomon and Kreisel, Georg},
	editor = {Barr, M. and Berthiaume, P. and Day, B. J. and Duskin, J. and Feferman, S. and Kelly, G. M. and Mac Lane, S. and Tierney, M. and Walters, R. F. C.},
	year = {1969},
	keywords = {Abelian Group, Category Theory, Closure Condition, Free Variable, Mathematical Practice},
	pages = {201--247},
	}
	@article{shulman_set_2008,
	title = {Set {Theory} for {Category} {Theory}},
	url = {http://arxiv.org/abs/0810.1279},
	journal = {arXiv:0810.1279 [math]},
	author = {Shulman, Michael A.},
	year = {2008},
	keywords = {Mathematics - Category Theory, Mathematics - Logic},
	}
	@incollection{barkaoui_partizan_2006,
	address = {Berlin},
	title = {Partizan {Games} in {Isabelle}/{HOLZF}},
	volume = {4281},
	isbn = {978-3-540-48815-6},
	booktitle = {{ICTAC} 2006},
	publisher = {Springer},
	author = {Obua, Steven},
	editor = {Barkaoui, Kamel and Cavalcanti, Ana and Cerone, Antonio},
	year = {2006},
	pages = {272--286},
	}
	@book{jech_set_2006,
	address = {Heidelberg},
	edition = {3},
	series = {Pure and applied mathematics},
	title = {Set {Theory}},
	isbn = {3-540-44085-2},
	number = {79},
	publisher = {Springer},
	author = {Jech, Thomas},
	year = {2006},
	keywords = {Set theory},
	}
	@incollection{sica_doing_2006,
	title = {On {Doing} {Category} {Theory} within {Set} {Theoretic} {Foundations}},
	isbn = {978-88-7699-031-1},
	booktitle = {What is {Category} {Theory}?},
	publisher = {Polimetrica s.a.s.},
	author = {Rao, Vidhyanath K.},
	editor = {Sica, Giandomenico},
	year = {2006},
	keywords = {Mathematics / General},
	}
	@unpublished{ballarin_tutorial_2020,
	title = {Tutorial to {Locales} and {Locale} {Interpretation}},
	url = {https://isabelle.in.tum.de/website-Isabelle2020/dist/Isabelle2020/doc/locales.pdf},
	author = {Ballarin, Clemens},
	year = {2020},
	}
	-@incollection{berardi_locales_2004,
	- address = {Heidelberg},
	- title = {Locales and {Locale} {Expressions} in {Isabelle}/{Isar}},
	- volume = {3085},
	- isbn = {978-3-540-22164-7},
	- booktitle = {Types for {Proofs} and {Programs}},
	- publisher = {Springer},
	- author = {Ballarin, Clemens},
	- editor = {Berardi, Stefano and Coppo, Mario and Damiani, Ferruccio},
	- year = {2004},
	- pages = {34--50},
	+@inproceedings{kuncar_types_2014,
	+ title = {From {Types} to {Sets} in {Isabelle}/{HOL}},
	+ booktitle = {Isabelle {Workshop}, {Vienna}, {Austria}, {July} 13, 2014, {Revised} {Selected} {Papers}},
	+ author = {Kun{\v c}ar, Ond{\v r}ej and Popescu, Andrei},
	+ year = {2014},
	}
	@misc{noauthor_isabellehol_2020,
	title = {Isabelle/{HOL} {Standard} {Library}},
	url = {https://isabelle.in.tum.de/website-Isabelle2020/dist/library/HOL/HOL/index.html},
	journal = {Isabelle/HOL},
	year = {2020},
	}
	@misc{eberl_syntax_2021,
	title = {Syntax proposal: multiway if},
	url = {https://lists.cam.ac.uk/pipermail/cl-isabelle-users/2021-February/msg00034.html},
	journal = {The Cl-isabelle-users Archives},
	author = {Eberl, Manuel},
	year = {2021},
	}
	@misc{noauthor_association_nodate,
	title = {Association of {Mizar} {Users}. {Mizar} home page.},
	url = {http://mizar.org/},
	}
	@article{bylinski_introduction_1990,
	title = {Introduction to {Categories} and {Functors}},
	volume = {1},
	number = {2},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1990},
	pages = {409--420},
	}
	@article{bylinski_subcategories_1990,
	title = {Subcategories and {Products} of {Categories}},
	volume = {1},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1990},
	pages = {725--732},
	}
	@article{bylinski_opposite_1991,
	title = {Opposite {Categories} and {Contravariant} {Functors}},
	volume = {2},
	number = {3},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1991},
	pages = {419--424},
	}
	@article{trybulec_natural_1991,
	title = {Natural {Transformations}. {Discrete} {Categories}},
	volume = {2},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Trybulec, Andrzej},
	year = {1991},
	pages = {467--474},
	}
	@article{bylinski_category_1991,
	title = {Category {Ens}},
	volume = {2},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1991},
	pages = {527--533},
	}
	@article{muzalewski_categories_1991,
	title = {Categories of {Groups}},
	volume = {2},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Muzalewski, Micha{\l }},
	year = {1991},
	pages = {563--571},
	}
	@article{trybulec_isomorphisms_1991,
	title = {Isomorphisms of {Categories}},
	volume = {2},
	number = {5},
	journal = {Formalized Mathematics},
	author = {Trybulec, Andrzej},
	year = {1991},
	pages = {629--634},
	}
	@article{muzalewski_category_1991,
	title = {Category of {Rings}},
	volume = {2},
	number = {5},
	journal = {Formalized Mathematics},
	author = {Muzalewski, Micha{\l }},
	year = {1991},
	pages = {643--648},
	}
	@article{muzalewski_category_1991-1,
	title = {Category of {Left} {Modules}},
	volume = {2},
	number = {5},
	journal = {Formalized Mathematics},
	author = {Muzalewski, Micha{\l }},
	year = {1991},
	pages = {649--652},
	}
	@article{bancerek_comma_1991,
	title = {Comma {Category}},
	volume = {2},
	number = {5},
	journal = {Formalized Mathematics},
	author = {Bancerek, Grzegorz and Darmochwa{\l }, Agata},
	year = {1991},
	pages = {679--681},
	}
	@article{bylinski_products_1991,
	title = {Products and {Coproducts} in {Categories}},
	volume = {2},
	number = {5},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1991},
	pages = {701--709},
	}
	@article{trybulec_isomorphisms_1992,
	title = {Some {Isomorphisms} {Between} {Functor} {Categories}},
	volume = {3},
	number = {1},
	journal = {Formalized Mathematics},
	author = {Trybulec, Andrzej},
	year = {1992},
	pages = {33--40},
	}
	@article{bylinski_cartesian_1992,
	title = {Cartesian {Categories}},
	volume = {3},
	number = {2},
	journal = {Formalized Mathematics},
	author = {Byli{\'n}ski, Czes{\l }aw},
	year = {1992},
	pages = {161--169},
	}
	@article{bancerek_categorial_1996,
	title = {Categorial {Categories} and {Slice} {Categories}},
	volume = {5},
	number = {2},
	journal = {Formalized Mathematics},
	author = {Bancerek, Grzegorz},
	year = {1996},
	pages = {157--165},
	}
	@article{trybulec_categories_1996,
	title = {Categories without {Uniqueness} of cod and dom},
	volume = {5},
	number = {2},
	journal = {Formalized Mathematics},
	author = {Trybulec, Andrzej},
	year = {1996},
	pages = {259--267},
	}
	@article{bancerek_indexed_1996,
	title = {Indexed {Category}},
	volume = {5},
	number = {3},
	journal = {Formalized Mathematics},
	author = {Bancerek, Grzegorz},
	year = {1996},
	pages = {329--337},
	}
	@article{trybulec_functors_1996,
	title = {Functors for {Alternative} {Categories}},
	volume = {5},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Trybulec, Andrzej},
	year = {1996},
	pages = {595--608},
	}
	@article{nieszczerzewski_category_1997,
	title = {Category of {Functors} {Between} {Alternative} {Categories}},
	volume = {6},
	number = {3},
	journal = {Formalized Mathematics},
	author = {Nieszczerzewski, Robert},
	year = {1997},
	pages = {371--375},
	}
	@article{kornilowicz_categories_1997,
	title = {On the {Categories} {Without} {Uniqueness} of cod and dom. {Some} {Properties} of the {Morphisms} and the {Functors}},
	volume = {6},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Korni{\l }owicz, Artur},
	year = {1997},
	pages = {475--481},
	}
	@article{kornilowicz_composition_1998,
	title = {The {Composition} of {Functors} and {Transformations} in {Alternative} {Categories}},
	volume = {7},
	number = {1},
	journal = {Formalized Mathematics},
	author = {Korni{\l }owicz, Artur},
	year = {1998},
	pages = {1--7},
	}
	@article{bancerek_concrete_2001,
	title = {Concrete {Categories}},
	volume = {9},
	number = {3},
	journal = {Formalized Mathematics},
	author = {Bancerek, Grzegorz},
	year = {2001},
	pages = {605--621},
	}
	@article{kornilowicz_products_2012,
	title = {Products in {Categories} without {Uniqueness} of cod and dom},
	volume = {20},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Korni{\l }owicz, Artur},
	year = {2012},
	pages = {303--307},
	}
	@article{riccardi_object-free_2013,
	title = {Object-{Free} {Definition} of {Categories}},
	volume = {21},
	number = {3},
	journal = {Formalized Mathematics},
	author = {Riccardi, Marco},
	year = {2013},
	keywords = {correspondence between different approaches to category, object-free category},
	pages = {193--205},
	}
	@article{golinski_coproducts_2013,
	title = {Coproducts in {Categories} without {Uniqueness} of cod and dom},
	volume = {21},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Goli{\'n}ski, Maciej and Korni{\l }owicz, Artur},
	year = {2013},
	keywords = {coproducts, disjoined union},
	pages = {235--239},
	}
	@book{grabowski_preface_2014,
	title = {Preface},
	volume = {22},
	number = {2},
	author = {Grabowski, Adam and Shidama, Yasunari},
	year = {2014},
	keywords = {Mizar, Mizar Mathematical Library},
	}
	@article{riccardi_categorical_2015,
	title = {Categorical {Pullbacks}},
	volume = {23},
	+ doi = {10.2478/forma-2015-0001},
	number = {1},
	journal = {Formalized Mathematics},
	author = {Riccardi, Marco},
	year = {2015},
	keywords = {category pullback, pullback lemma},
	pages = {1--14},
	}
	@article{riccardi_exponential_2015,
	title = {Exponential {Objects}},
	volume = {23},
	number = {4},
	journal = {Formalized Mathematics},
	author = {Riccardi, Marco},
	year = {2015},
	keywords = {exponential objects, functor category, natural transformation},
	pages = {351--369},
	}
	@article{paulson_natural_1986,
	title = {Natural {Deduction} as {Higher}-{Order} {Resolution}},
	volume = {3},
	+ doi = {10.1016/0743-1066(86)90015-4},
	number = {3},
	journal = {The Journal of Logic Programming},
	author = {Paulson, Lawrence C.},
	year = {1986},
	pages = {237--258},
	}
	@book{riehl_category_2016,
	title = {Category {Theory} in {Context}},
	publisher = {Emily Riehl},
	author = {Riehl, Emily},
	year = {2016},
	keywords = {Mathematics / Logic},
	}
	@misc{chen_hotg_2021,
	title = {{HOTG}},
	url = {https://bitbucket.org/cezaryka/tyset/src},
	journal = {HOTG},
	author = {Chen, Joshua and Kappelmann, Kevin and Krauss, Alexander},
	year = {2021},
	}
	@misc{haftmann_sketch-and-explore_2021,
	title = {Sketch-and-{Explore}},
	url = {https://isabelle.in.tum.de/library/HOL/HOL-ex/Sketch_and_Explore.html},
	author = {Haftmann, Florian},
	year = {2021},
	}
	@book{megill_metamath_2019,
	address = {Morrisville, North Carolina},
	title = {Metamath: {A} {Computer} {Language} for {Mathematical} {Proofs}},
	isbn = {978-0-359-70223-7},
	publisher = {Lulu Press},
	author = {Megill, Norman and Wheeler, David A.},
	year = {2019},
	}
	@inproceedings{kammuller_locales_1999,
	- address = {Heidelberg},
	+ address = {Heidelberg, Germany},
	series = {Lecture {Notes} in {Computer} {Science}},
	title = {Locales {A} {Sectioning} {Concept} for {Isabelle}},
	isbn = {978-3-540-48256-7},
	- booktitle = {Theorem {Proving} in {Higher} {Order} {Logics}},
	+ doi = {10.1007/3-540-48256-3_11},
	+ booktitle = {Proceedings of the 12th {International} {Conference} on {Theorem} {Proving} in {Higher} {Order} {Logics}, {TPHOLs}'99, {Nice}, {France}, {September}, 1999},
	publisher = {Springer},
	author = {Kamm{\"u}ller, Florian and Wenzel, Markus and Paulson, Lawrence C.},
	editor = {Bertot, Yves and Dowek, Gilles and Th{\'e}ry, Laurent and Hirschowitz, Andr{\'e} and Paulin-Mohring, Christine},
	year = {1999},
	pages = {149--165},
	}
	@article{milehins_category_2021,
	title = {Category {Theory} for {ZFC} in {HOL} {II}: {Elementary} {Theory} of 1-{Categories}},
	journal = {Archive of Formal Proofs},
	author = {Milehins, Mihails},
	year = {2021},
	}
	+@inproceedings{caccamo_higher-order_2001,
	+ address = {Berlin, Heidelberg},
	+ title = {A {Higher}-{Order} {Calculus} for {Categories}},
	+ isbn = {978-3-540-44755-9},
	+ doi = {10.1007/3-540-44755-5_11},
	+ booktitle = {Theorem {Proving} in {Higher} {Order} {Logics}},
	+ publisher = {Springer},
	+ author = {C{\'a}ccamo, Mario and Winskel, Glynn},
	+ editor = {Boulton, Richard J. and Jackson, Paul B.},
	+ year = {2001},
	+ pages = {136--153},
	+}
	+@techreport{caccamo_higher-order_2001-1,
	+ address = {Aarhus, Denmark},
	+ title = {A {Higher}-{Order} {Calculus} for {Categories}},
	+ institution = {University of Aarhus},
	+ author = {C{\'a}ccamo, Mario Jose and Winskel, Glynn},
	+ year = {2001},
	+}
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Adjoints.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Adjoints.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Adjoints.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Adjoints.thy
	@@ -1,3641 +1,3997 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Adjoints\<close>
	theory CZH_UCAT_Adjoints
	imports
	- CZH_UCAT_Universal
	+ CZH_UCAT_Limit
	CZH_Elementary_Categories.CZH_ECAT_Yoneda
	begin



	subsection\<open>Background\<close>

	named_theorems adj_cs_simps
	named_theorems adj_cs_intros
	named_theorems adj_field_simps

	definition AdjLeft :: V where [adj_field_simps]: "AdjLeft = 0"
	definition AdjRight :: V where [adj_field_simps]: "AdjRight = 1\<^sub>\<nat>"
	definition AdjNT :: V where [adj_field_simps]: "AdjNT = 2\<^sub>\<nat>"



	subsection\<open>Definition and elementary properties\<close>


	text\<open>
	See subsection 2.1 in \cite{bodo_categories_1970} or Chapter IV-1 in
	\cite{mac_lane_categories_2010}.
	\<close>

	locale is_cf_adjunction =
	\<Z> \<alpha> +
	vfsequence \<Phi> +
	L: category \<alpha> \<CC> +
	R: category \<alpha> \<DD> +
	LR: is_functor \<alpha> \<CC> \<DD> \<FF> +
	RL: is_functor \<alpha> \<DD> \<CC> \<GG> +
	NT: is_iso_ntcf
	\<alpha>
	\<open>op_cat \<CC> \<times>\<^sub>C \<DD>\<close>
	\<open>cat_Set \<alpha>\<close>
	\<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)\<close>
	\<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)\<close>
	\<open>\<Phi>\<lparr>AdjNT\<rparr>\<close>
	for \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> +
	assumes cf_adj_length[adj_cs_simps]: "vcard \<Phi> = 3\<^sub>\<nat>"
	and cf_adj_AdjLeft[adj_cs_simps]: "\<Phi>\<lparr>AdjLeft\<rparr> = \<FF>"
	and cf_adj_AdjRight[adj_cs_simps]: "\<Phi>\<lparr>AdjRight\<rparr> = \<GG>"

	syntax "_is_cf_adjunction" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ : _ \<rightleftharpoons>\<^sub>C\<^sub>F _ : _ \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" \<rightleftharpoons>
	"CONST is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi>"

	lemmas [adj_cs_simps] =
	is_cf_adjunction.cf_adj_length
	is_cf_adjunction.cf_adj_AdjLeft
	is_cf_adjunction.cf_adj_AdjRight


	text\<open>Components.\<close>

	lemma cf_adjunction_components[adj_cs_simps]:
	"[\<FF>, \<GG>, \<phi>]\<^sub>\<circ>\<lparr>AdjLeft\<rparr> = \<FF>"
	"[\<FF>, \<GG>, \<phi>]\<^sub>\<circ>\<lparr>AdjRight\<rparr> = \<GG>"
	"[\<FF>, \<GG>, \<phi>]\<^sub>\<circ>\<lparr>AdjNT\<rparr> = \<phi>"
	unfolding AdjLeft_def AdjRight_def AdjNT_def
	by (simp_all add: nat_omega_simps)


	text\<open>Rules.\<close>

	lemma (in is_cf_adjunction) is_cf_adjunction_axioms'[adj_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "\<CC>' = \<CC>" and "\<DD>' = \<DD>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
	shows "\<Phi> : \<FF>' \<rightleftharpoons>\<^sub>C\<^sub>F \<GG>' : \<CC>' \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<DD>'"
	unfolding assms by (rule is_cf_adjunction_axioms)

	lemmas (in is_cf_adjunction) [adj_cs_intros] = is_cf_adjunction_axioms

	mk_ide rf is_cf_adjunction_def[unfolded is_cf_adjunction_axioms_def]
	\|intro is_cf_adjunctionI\|
	\|dest is_cf_adjunctionD[dest]\|
	\|elim is_cf_adjunctionE[elim]\|

	lemmas [adj_cs_intros] = is_cf_adjunctionD(3-6)

	lemma (in is_cf_adjunction) cf_adj_is_iso_ntcf':
	assumes "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)"
	and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)"
	and "\<AA>' = op_cat \<CC> \<times>\<^sub>C \<DD>"
	and "\<BB>' = cat_Set \<alpha>"
	shows "\<Phi>\<lparr>AdjNT\<rparr> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (auto intro: cat_cs_intros)

	lemmas [adj_cs_intros] = is_cf_adjunction.cf_adj_is_iso_ntcf'

	lemma cf_adj_eqI:
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<Phi>' : \<FF>' \<rightleftharpoons>\<^sub>C\<^sub>F \<GG>' : \<CC>' \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>'"
	and "\<CC> = \<CC>'"
	and "\<DD> = \<DD>'"
	and "\<FF> = \<FF>'"
	and "\<GG> = \<GG>'"
	and "\<Phi>\<lparr>AdjNT\<rparr> = \<Phi>'\<lparr>AdjNT\<rparr>"
	shows "\<Phi> = \<Phi>'"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Phi>': is_cf_adjunction \<alpha> \<CC>' \<DD>' \<FF>' \<GG>' \<Phi>' by (rule assms(2))
	show ?thesis
	proof(rule vsv_eqI)
	have dom: "\<D>\<^sub>\<circ> \<Phi> = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: V_cs_simps adj_cs_simps)
	show "\<D>\<^sub>\<circ> \<Phi> = \<D>\<^sub>\<circ> \<Phi>'"
	by (cs_concl cs_shallow cs_simp: V_cs_simps adj_cs_simps dom)
	from assms(4-7) have sup:
	"\<Phi>\<lparr>AdjLeft\<rparr> = \<Phi>'\<lparr>AdjLeft\<rparr>"
	"\<Phi>\<lparr>AdjRight\<rparr> = \<Phi>'\<lparr>AdjRight\<rparr>"
	"\<Phi>\<lparr>AdjNT\<rparr> = \<Phi>'\<lparr>AdjNT\<rparr>"
	by (simp_all add: adj_cs_simps)
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<Phi> \<Longrightarrow> \<Phi>\<lparr>a\<rparr> = \<Phi>'\<lparr>a\<rparr>" for a
	by (unfold dom, elim_in_numeral, insert sup)
	(auto simp: adj_field_simps)
	qed (auto simp: \<Phi>.L.vsv_axioms \<Phi>'.vsv_axioms)
	qed



	subsection\<open>Opposite adjunction\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See \cite{kan_adjoint_1958} for further information.\<close>

	abbreviation op_cf_adj_nt :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "op_cf_adj_nt \<CC> \<DD> \<phi> \<equiv> inv_ntcf (bnt_flip (op_cat \<CC>) \<DD> \<phi>)"

	definition op_cf_adj :: "V \<Rightarrow> V"
	where "op_cf_adj \<Phi> =
	[
	op_cf (\<Phi>\<lparr>AdjRight\<rparr>),
	op_cf (\<Phi>\<lparr>AdjLeft\<rparr>),
	op_cf_adj_nt (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>) (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>) (\<Phi>\<lparr>AdjNT\<rparr>)
	]\<^sub>\<circ>"

	lemma op_cf_adj_components:
	shows "op_cf_adj \<Phi>\<lparr>AdjLeft\<rparr> = op_cf (\<Phi>\<lparr>AdjRight\<rparr>)"
	and "op_cf_adj \<Phi>\<lparr>AdjRight\<rparr> = op_cf (\<Phi>\<lparr>AdjLeft\<rparr>)"
	and "op_cf_adj \<Phi>\<lparr>AdjNT\<rparr> =
	op_cf_adj_nt (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>) (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>) (\<Phi>\<lparr>AdjNT\<rparr>)"
	unfolding op_cf_adj_def adj_field_simps by (simp_all add: nat_omega_simps)

	lemma (in is_cf_adjunction) op_cf_adj_components:
	shows "op_cf_adj \<Phi>\<lparr>AdjLeft\<rparr> = op_cf \<GG>"
	and "op_cf_adj \<Phi>\<lparr>AdjRight\<rparr> = op_cf \<FF>"
	and "op_cf_adj \<Phi>\<lparr>AdjNT\<rparr> = inv_ntcf (bnt_flip (op_cat \<CC>) \<DD> (\<Phi>\<lparr>AdjNT\<rparr>))"
	unfolding op_cf_adj_components by (simp_all add: cat_cs_simps adj_cs_simps)

	lemmas [cat_op_simps] = is_cf_adjunction.op_cf_adj_components


	text\<open>The opposite adjunction is an adjunction.\<close>

	lemma (in is_cf_adjunction) is_cf_adjunction_op:
	\<comment>\<open>See comments in subsection 2.1 in \cite{bodo_categories_1970}.\<close>
	"op_cf_adj \<Phi> : op_cf \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<DD> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	proof(intro is_cf_adjunctionI, unfold cat_op_simps, unfold op_cf_adj_components)
	show "vfsequence (op_cf_adj \<Phi>)" unfolding op_cf_adj_def by simp
	show "vcard (op_cf_adj \<Phi>) = 3\<^sub>\<nat>"
	unfolding op_cf_adj_def by (simp add: nat_omega_simps)
	note adj = is_cf_adjunctionD[OF is_cf_adjunction_axioms]
	from adj have f_\<phi>: "bnt_flip (op_cat \<CC>) \<DD> (\<Phi>\<lparr>AdjNT\<rparr>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<DD>(-,op_cf \<FF>-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(op_cf \<GG>-,-) :
	\<DD> \<times>\<^sub>C op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	show "op_cf_adj_nt \<CC> \<DD> (\<Phi>\<lparr>AdjNT\<rparr>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(op_cf \<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<DD>(-,op_cf \<FF>-) :
	\<DD> \<times>\<^sub>C op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- by (rule CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF f_\<phi>])
	+ by (rule CZH_ECAT_NTCF.iso_ntcf_is_iso_arr(1)[OF f_\<phi>])
	qed (auto intro: cat_cs_intros cat_op_intros)

	lemmas is_cf_adjunction_op =
	is_cf_adjunction.is_cf_adjunction_op

	lemma (in is_cf_adjunction) is_cf_adjunction_op'[cat_op_intros]:
	assumes "\<GG>' = op_cf \<GG>"
	and "\<FF>' = op_cf \<FF>"
	and "\<DD>' = op_cat \<DD>"
	and "\<CC>' = op_cat \<CC>"
	shows "op_cf_adj \<Phi> : \<GG>' \<rightleftharpoons>\<^sub>C\<^sub>F \<FF>' : \<DD>' \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule is_cf_adjunction_op)

	lemmas [cat_op_intros] = is_cf_adjunction.is_cf_adjunction_op'


	text\<open>The operation of taking the opposite adjunction is an involution.\<close>

	lemma (in is_cf_adjunction) cf_adjunction_op_cf_adj_op_cf_adj[cat_op_simps]:
	"op_cf_adj (op_cf_adj \<Phi>) = \<Phi>"
	proof(rule cf_adj_eqI)
	show \<Phi>': "op_cf_adj (op_cf_adj \<Phi>) : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof(intro is_cf_adjunctionI)
	show "vfsequence (op_cf_adj (op_cf_adj \<Phi>))" unfolding op_cf_adj_def by simp
	from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) :
	op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
	cs_simp: cat_cs_simps cat_op_simps
	)
	show "vcard (op_cf_adj (op_cf_adj \<Phi>)) = 3\<^sub>\<nat>"
	unfolding op_cf_adj_def by (simp add: nat_omega_simps)
	from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjLeft\<rparr> = \<FF>"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjRight\<rparr> = \<GG>"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	qed (auto intro: cat_cs_intros)
	interpret \<Phi>': is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<open>op_cf_adj (op_cf_adj \<Phi>)\<close>
	by (rule \<Phi>')
	show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr> = \<Phi>\<lparr>AdjNT\<rparr>"
	proof(rule ntcf_eqI)
	show op_op_\<Phi>:
	"op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) :
	op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule \<Phi>'.NT.is_ntcf_axioms)
	show \<Phi>: "\<Phi>\<lparr>AdjNT\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) :
	op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule NT.is_ntcf_axioms)
	from op_op_\<Phi> have dom_lhs:
	"\<D>\<^sub>\<circ> (op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr> = \<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold NT.ntcf_NTMap_vdomain dom_lhs)
	fix cd assume prems: "cd \<in>\<^sub>\<circ> (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	then obtain c d
	where cd_def: "cd = [c, d]\<^sub>\<circ>"
	and c: "c \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	and d: "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (elim cat_prod_2_ObjE[OF L.category_op R.category_axioms prems])
	from is_cf_adjunction_axioms c d L.category_axioms R.category_axioms \<Phi>
	show "op_cf_adj (op_cf_adj \<Phi>)\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>cd\<rparr> = \<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>cd\<rparr>"
	unfolding cd_def cat_op_simps
	- by
	+ by
	(
	cs_concl
	cs_intro:
	cat_arrow_cs_intros
	ntcf_cs_intros
	adj_cs_intros
	cat_op_intros
	cat_cs_intros
	cat_prod_cs_intros
	cs_simp: cat_cs_simps cat_op_simps
	)
	qed (auto intro: inv_ntcf_NTMap_vsv)
	qed simp_all
	qed (auto intro: adj_cs_intros)

	lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj


	-
	subsubsection\<open>Alternative form of the naturality condition\<close>


	text\<open>
	The lemmas in this subsection are based on the comments on page 81 in
	\cite{mac_lane_categories_2010}.
	\<close>

	lemma (in is_cf_adjunction) cf_adj_Comp_commute_RL:
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> a"
	and "k : a \<mapsto>\<^bsub>\<DD>\<^esub> a'"
	shows
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a'\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>k \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f\<rparr>"
	proof-
	from
	assms
	is_cf_adjunction_axioms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have \<phi>_x_a: "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	note \<phi>_x_a_f =
	cat_Set_ArrVal_app_vrange[OF \<phi>_x_a, unfolded in_Hom_iff, OF assms(2)]
	from
	is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have \<phi>_x_a':
	"\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a'\<rparr>\<^sub>\<bullet> :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	from is_cf_adjunction_axioms this assms have x_k:
	"[\<CC>\<lparr>CId\<rparr>\<lparr>x\<rparr>, k]\<^sub>\<circ> : [x, a]\<^sub>\<circ> \<mapsto>\<^bsub>op_cat \<CC> \<times>\<^sub>C \<DD>\<^esub> [x, a']\<^sub>\<circ>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	from
	NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have
	"\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<DD> [\<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>, k]\<^sub>\<circ> =
	cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>x\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>"
	(is \<open>?lhs = ?rhs\<close>)
	by (slow)
	(
	cs_prems cs_ist_simple
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	moreover from
	is_cf_adjunction_axioms assms \<phi>_x_a'
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have "?lhs\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a'\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>k \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	moreover from
	is_cf_adjunction_axioms assms \<phi>_x_a_f
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have
	"?rhs\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	ultimately show ?thesis by simp
	qed

	lemma (in is_cf_adjunction) cf_adj_Comp_commute_LR:
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> a"
	and "h : x' \<mapsto>\<^bsub>\<CC>\<^esub> x"
	shows
	"(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h =
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x', a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr>"
	proof-
	from
	is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have \<phi>_x_a: "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	note \<phi>_x_a_f =
	cat_Set_ArrVal_app_vrange[OF \<phi>_x_a, unfolded in_Hom_iff, OF assms(2)]
	from is_cf_adjunction_axioms assms have
	"[h, \<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>]\<^sub>\<circ> : [x, a]\<^sub>\<circ> \<mapsto>\<^bsub>op_cat \<CC> \<times>\<^sub>C \<DD>\<^esub> [x', a]\<^sub>\<circ>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	from
	NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have
	"\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x', a\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<DD> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>, \<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>]\<^sub>\<circ> =
	cf_hom \<CC> [h, \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>"
	(is \<open>?lhs = ?rhs\<close>)
	by (slow)
	(
	cs_prems
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	moreover from
	is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have "?lhs\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x', a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	moreover from
	is_cf_adjunction_axioms assms \<phi>_x_a_f
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have "?rhs\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	ultimately show ?thesis by simp
	qed



	subsection\<open>Unit\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>

	definition cf_adjunction_unit :: "V \<Rightarrow> V" (\<open>\<eta>\<^sub>C\<close>)
	where "\<eta>\<^sub>C \<Phi> =
	[
	(
	\<lambda>x\<in>\<^sub>\<circ>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>
	\<rparr>
	),
	cf_id (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>),
	(\<Phi>\<lparr>AdjRight\<rparr>) \<circ>\<^sub>C\<^sub>F (\<Phi>\<lparr>AdjLeft\<rparr>),
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>,
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_adjunction_unit_components:
	shows "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>
	\<rparr>
	)"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDom\<rparr> = cf_id (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>)"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTCod\<rparr> = (\<Phi>\<lparr>AdjRight\<rparr>) \<circ>\<^sub>C\<^sub>F (\<Phi>\<lparr>AdjLeft\<rparr>)"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDGDom\<rparr> = \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDGCod\<rparr> = \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>"
	unfolding cf_adjunction_unit_def nt_field_simps
	by (simp_all add: nat_omega_simps)

	context is_cf_adjunction
	begin

	lemma cf_adjunction_unit_components':
	shows "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr> =
	(\<lambda>x\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>\<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<rparr>)"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDom\<rparr> = cf_id \<CC>"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDGDom\<rparr> = \<CC>"
	and "\<eta>\<^sub>C \<Phi>\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding cf_adjunction_unit_components
	by (cs_concl cs_shallow cs_simp: cat_cs_simps adj_cs_simps)+

	mk_VLambda cf_adjunction_unit_components'(1)
	\|vdomain cf_adjunction_unit_NTMap_vdomain[adj_cs_simps]\|
	\|app cf_adjunction_unit_NTMap_app[adj_cs_simps]\|

	end

	mk_VLambda cf_adjunction_unit_components(1)
	\|vsv cf_adjunction_unit_NTMap_vsv[adj_cs_intros]\|

	lemmas [adj_cs_simps] =
	is_cf_adjunction.cf_adjunction_unit_NTMap_vdomain
	is_cf_adjunction.cf_adjunction_unit_NTMap_app


	subsubsection\<open>Natural transformation map\<close>

	lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr:
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	proof-
	from
	is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have \<phi>_x_\<FF>x:
	"\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<^sub>\<bullet> :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	from is_cf_adjunction_axioms assms have CId_\<FF>x:
	"\<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
	from
	is_cf_adjunction_axioms
	assms
	cat_Set_ArrVal_app_vrange[OF \<phi>_x_\<FF>x, unfolded in_Hom_iff, OF CId_\<FF>x]
	show "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
	qed

	lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr':
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a = x"
	and "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	and "\<CC>' = \<CC>"
	shows "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : x \<mapsto>\<^bsub>\<CC>'\<^esub> b"
	using assms(1) unfolding assms(2-4) by (rule cf_adjunction_unit_NTMap_is_arr)

	lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr'

	lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_vrange:
	"\<R>\<^sub>\<circ> (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cf_adjunction_unit_NTMap_vdomain)
	fix x assume prems: "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from cf_adjunction_unit_NTMap_is_arr[OF prems] show "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
	by auto
	qed (auto intro: adj_cs_intros)


	subsubsection\<open>Unit is a natural transformation\<close>

	lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf:
	"\<eta>\<^sub>C \<Phi> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_ntcfI')
	show "vfsequence (\<eta>\<^sub>C \<Phi>)" unfolding cf_adjunction_unit_def by simp
	show "vcard (\<eta>\<^sub>C \<Phi>) = 5\<^sub>\<nat>"
	unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
	from is_cf_adjunction_axioms show "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	from is_cf_adjunction_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	from is_cf_adjunction_axioms show "\<D>\<^sub>\<circ> (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
	show "\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	using is_cf_adjunction_axioms that
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	show
	"\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_id \<CC>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	using is_cf_adjunction_axioms that
	by
	(
	cs_concl
	cs_simp:
	cf_adj_Comp_commute_RL cf_adj_Comp_commute_LR
	cat_cs_simps
	adj_cs_simps
	cs_intro: cat_cs_intros adj_cs_intros
	)
	qed (auto simp: cf_adjunction_unit_components')

	lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf':
	assumes "\<SS> = cf_id \<CC>"
	and "\<SS>' = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	and "\<AA> = \<CC>"
	and "\<BB> = \<CC>"
	shows "\<eta>\<^sub>C \<Phi> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule cf_adjunction_unit_is_ntcf)

	lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_is_ntcf'


	subsubsection\<open>Every component of a unit is a universal arrow\<close>


	text\<open>
	The lemmas in this subsection are based on elements of the statement of
	Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>

	lemma (in is_cf_adjunction) cf_adj_umap_of_unit:
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	- shows "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> =
	- umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) a"
	+ shows "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> = umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) a"
	(is \<open>\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> = ?uof_a\<close>)
	proof-

	from
	is_cf_adjunction_axioms assms
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	have \<phi>_xa: "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>) = Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from is_cf_adjunction_axioms assms have uof_a:
	"?uof_a : Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> (?uof_a\<lparr>ArrVal\<rparr>) = Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a"
	by (cs_concl cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from \<phi>_xa show arr_Set_\<phi>_xa: "arr_Set \<alpha> (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)"
	by (auto dest: cat_Set_is_arrD(1))
	from uof_a show arr_Set_uof_a: "arr_Set \<alpha> ?uof_a"
	by (auto dest: cat_Set_is_arrD(1))
	show "(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr> = ?uof_a\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix g assume prems: "g : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> a"
	from is_cf_adjunction_axioms assms prems show
	"(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?uof_a\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cf_adj_Comp_commute_RL
	adj_cs_simps
	cat_cs_simps
	cat_op_simps
	cat_prod_cs_simps
	cs_intro:
	adj_cs_intros
	ntcf_cs_intros
	cat_cs_intros
	cat_op_intros
	cat_prod_cs_intros
	)
	qed (use arr_Set_\<phi>_xa arr_Set_uof_a in auto)

	qed (use \<phi>_xa uof_a in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed

	lemma (in is_cf_adjunction) cf_adj_umap_of_unit':
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	and "\<eta> = \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	and "\<FF>x = \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	shows "\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> = umap_of \<GG> x \<FF>x \<eta> a"
	using assms(1,2) unfolding assms(3,4) by (rule cf_adj_umap_of_unit)

	lemma (in is_cf_adjunction) cf_adjunction_unit_component_is_ua_of:
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "universal_arrow_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	(is \<open>universal_arrow_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) ?\<eta>x\<close>)
	proof(rule RL.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf)
	from is_cf_adjunction_axioms assms show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros adj_cs_intros)
	from is_cf_adjunction_axioms assms show
	"\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros adj_cs_intros)
	show
	"ntcf_ua_of \<alpha> \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(x,-) \<circ>\<^sub>C\<^sub>F \<GG> :
	\<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	(is \<open>?ntcf_ua_of : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o ?H\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>\<close>)
	proof(rule is_iso_ntcfI)
	from is_cf_adjunction_axioms assms show
	"?ntcf_ua_of : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F ?H\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (intro RL.cf_ntcf_ua_of_is_ntcf)
	(cs_concl cs_shallow cs_intro: cat_cs_intros adj_cs_intros)+
	fix a assume prems: "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	from assms prems have
	"\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> = umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) ?\<eta>x a"
	(is \<open>\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> = ?uof_a\<close>)
	by (rule cf_adj_umap_of_unit)
	from assms prems L.category_axioms R.category_axioms have
	"[x, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_op_intros cat_prod_cs_intros)
	from
	- NT.iso_ntcf_is_arr_isomorphism[
	+ NT.iso_ntcf_is_iso_arr[
	OF this, unfolded cf_adj_umap_of_unit[OF assms prems]
	]
	is_cf_adjunction_axioms assms prems
	L.category_axioms R.category_axioms
	have "?uof_a : Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps
	cs_intro:
	cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
	)
	with is_cf_adjunction_axioms assms prems show
	"?ntcf_ua_of\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : ?H\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> ?H\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
	)
	qed
	qed



	subsection\<open>Counit\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_adjunction_counit :: "V \<Rightarrow> V" (\<open>\<epsilon>\<^sub>C\<close>)
	where "\<epsilon>\<^sub>C \<Phi> =
	[
	(
	\<lambda>x\<in>\<^sub>\<circ>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>\<Phi>\<lparr>AdjRight\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>, x\<rparr>\<^sub>\<bullet>)\<inverse>\<^sub>S\<^sub>e\<^sub>t\<lparr>ArrVal\<rparr>\<lparr>
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>\<Phi>\<lparr>AdjRight\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>
	\<rparr>
	),
	(\<Phi>\<lparr>AdjLeft\<rparr>) \<circ>\<^sub>C\<^sub>F (\<Phi>\<lparr>AdjRight\<rparr>),
	cf_id (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>),
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>,
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_adjunction_counit_components:
	shows "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>\<Phi>\<lparr>AdjRight\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>, x\<rparr>\<^sub>\<bullet>)\<inverse>\<^sub>S\<^sub>e\<^sub>t\<lparr>ArrVal\<rparr>\<lparr>
	\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>\<Phi>\<lparr>AdjRight\<rparr>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>
	\<rparr>
	)"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDom\<rparr> = (\<Phi>\<lparr>AdjLeft\<rparr>) \<circ>\<^sub>C\<^sub>F (\<Phi>\<lparr>AdjRight\<rparr>)"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTCod\<rparr> = cf_id (\<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>)"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDGDom\<rparr> = \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDGCod\<rparr> = \<Phi>\<lparr>AdjLeft\<rparr>\<lparr>HomCod\<rparr>"
	unfolding cf_adjunction_counit_def nt_field_simps
	by (simp_all add: nat_omega_simps)

	context is_cf_adjunction
	begin

	lemma cf_adjunction_counit_components':
	shows "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<DD>\<lparr>Obj\<rparr>.
	(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>, x\<rparr>\<^sub>\<bullet>)\<inverse>\<^sub>S\<^sub>e\<^sub>t\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<rparr>
	)"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDom\<rparr> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTCod\<rparr> = cf_id \<DD>"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDGDom\<rparr> = \<DD>"
	and "\<epsilon>\<^sub>C \<Phi>\<lparr>NTDGCod\<rparr> = \<DD>"
	unfolding cf_adjunction_counit_components
	by (cs_concl cs_shallow cs_simp: cat_cs_simps adj_cs_simps)+

	mk_VLambda cf_adjunction_counit_components'(1)
	\|vdomain cf_adjunction_counit_NTMap_vdomain[adj_cs_simps]\|
	\|app cf_adjunction_counit_NTMap_app[adj_cs_simps]\|

	end

	mk_VLambda cf_adjunction_counit_components(1)
	\|vsv cf_adjunction_counit_NTMap_vsv[adj_cs_intros]\|

	lemmas [adj_cs_simps] =
	is_cf_adjunction.cf_adjunction_counit_NTMap_vdomain
	is_cf_adjunction.cf_adjunction_counit_NTMap_app


	subsubsection\<open>Duality for the unit and counit\<close>

	lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_op:
	"\<eta>\<^sub>C (op_cf_adj \<Phi>)\<lparr>NTMap\<rparr> = \<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>"
	proof-
	interpret op_\<Phi>:
	is_cf_adjunction \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> \<open>op_cf_adj \<Phi>\<close>
	by (rule is_cf_adjunction_op)
	show ?thesis
	proof
	(
	rule vsv_eqI,
	unfold
	cf_adjunction_counit_NTMap_vdomain
	op_\<Phi>.cf_adjunction_unit_NTMap_vdomain
	)
	fix a assume prems: "a \<in>\<^sub>\<circ> op_cat \<DD>\<lparr>Obj\<rparr>"
	then have a: "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	from is_cf_adjunction_axioms a show
	"\<eta>\<^sub>C (op_cf_adj \<Phi>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Set_cs_simps cat_cs_simps cat_op_simps adj_cs_simps
	cs_intro:
	cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed
	(
	simp_all add:
	cat_op_simps cf_adjunction_counit_NTMap_vsv cf_adjunction_unit_NTMap_vsv
	)
	qed


	lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_unit_NTMap_op

	lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_op:
	"\<epsilon>\<^sub>C (op_cf_adj \<Phi>)\<lparr>NTMap\<rparr> = \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>"
	by
	(
	rule is_cf_adjunction.cf_adjunction_unit_NTMap_op[
	OF is_cf_adjunction_op,
	unfolded is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj[
	OF is_cf_adjunction_axioms
	],
	unfolded cat_op_simps,
	symmetric
	]
	)

	lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_counit_NTMap_op

	lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_counit:
	"op_ntcf (\<epsilon>\<^sub>C \<Phi>) = \<eta>\<^sub>C (op_cf_adj \<Phi>)"
	(is \<open>?\<epsilon> = ?\<eta>\<close>)
	proof(rule vsv_eqI)
	interpret op_\<Phi>:
	is_cf_adjunction \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> \<open>op_cf_adj \<Phi>\<close>
	by (rule is_cf_adjunction_op)
	have dom_lhs: "\<D>\<^sub>\<circ> ?\<epsilon> = 5\<^sub>\<nat>" unfolding op_ntcf_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> ?\<eta> = 5\<^sub>\<nat>"
	unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> ?\<epsilon> = \<D>\<^sub>\<circ> ?\<eta>" unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ?\<epsilon> \<Longrightarrow> ?\<epsilon>\<lparr>a\<rparr> = ?\<eta>\<lparr>a\<rparr>" for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	fold nt_field_simps,
	unfold cf_adjunction_unit_NTMap_op,
	unfold
	cf_adjunction_counit_components'
	cf_adjunction_unit_components'
	op_\<Phi>.cf_adjunction_counit_components'
	op_\<Phi>.cf_adjunction_unit_components'
	cat_op_simps
	)
	simp_all
	qed (auto simp: op_ntcf_def cf_adjunction_unit_def)

	lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_counit

	lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_unit:
	"op_ntcf (\<eta>\<^sub>C \<Phi>) = \<epsilon>\<^sub>C (op_cf_adj \<Phi>)"
	(is \<open>?\<eta> = ?\<epsilon>\<close>)
	proof(rule vsv_eqI)
	interpret op_\<Phi>:
	is_cf_adjunction \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> \<open>op_cf_adj \<Phi>\<close>
	by (rule is_cf_adjunction_op)
	have dom_lhs: "\<D>\<^sub>\<circ> ?\<eta> = 5\<^sub>\<nat>"
	unfolding op_ntcf_def by (simp add: nat_omega_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> ?\<epsilon> = 5\<^sub>\<nat>"
	unfolding cf_adjunction_counit_def by (simp add: nat_omega_simps)
	show "\<D>\<^sub>\<circ> ?\<eta> = \<D>\<^sub>\<circ> ?\<epsilon>" unfolding dom_lhs dom_rhs by simp
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ?\<eta> \<Longrightarrow> ?\<eta>\<lparr>a\<rparr> = ?\<epsilon>\<lparr>a\<rparr>" for a
	by
	(
	unfold dom_lhs,
	elim_in_numeral,
	fold nt_field_simps,
	unfold cf_adjunction_counit_NTMap_op,
	unfold
	cf_adjunction_counit_components'
	cf_adjunction_unit_components'
	op_\<Phi>.cf_adjunction_counit_components'
	op_\<Phi>.cf_adjunction_unit_components'
	cat_op_simps
	)
	simp_all
	qed (auto simp: op_ntcf_def cf_adjunction_counit_def)

	lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_unit


	subsubsection\<open>Natural transformation map\<close>

	lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr:
	assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	shows "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> x"
	proof-
	from assms have x: "x \<in>\<^sub>\<circ> op_cat \<DD>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
	show ?thesis
	by
	(
	rule is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr[
	OF is_cf_adjunction_op x,
	unfolded cf_adjunction_unit_NTMap_op cat_op_simps
	]
	)
	qed

	lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr':
	assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	and "a = \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	and "b = x"
	and "\<DD>' = \<DD>"
	shows "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : a \<mapsto>\<^bsub>\<DD>'\<^esub> b"
	using assms(1) unfolding assms(2-4) by (rule cf_adjunction_counit_NTMap_is_arr)

	lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_NTMap_is_arr'

	lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_vrange:
	"\<R>\<^sub>\<circ> (\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
	by
	(
	rule is_cf_adjunction.cf_adjunction_unit_NTMap_vrange[
	OF is_cf_adjunction_op,
	unfolded cf_adjunction_unit_NTMap_op cat_op_simps
	]
	)


	subsubsection\<open>Counit is a natural transformation\<close>

	lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf:
	"\<epsilon>\<^sub>C \<Phi> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	from is_cf_adjunction.cf_adjunction_unit_is_ntcf[OF is_cf_adjunction_op] have
	"\<epsilon>\<^sub>C \<Phi> :
	op_cf (op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<GG>) \<mapsto>\<^sub>C\<^sub>F op_cf (cf_id (op_cat \<DD>)) :
	op_cat (op_cat \<DD>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (op_cat \<DD>)"
	unfolding
	is_cf_adjunction.op_ntcf_cf_adjunction_unit[
	OF is_cf_adjunction_op, unfolded cat_op_simps, symmetric
	]
	by (rule is_ntcf.is_ntcf_op)
	then show ?thesis unfolding cat_op_simps .
	qed

	lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf':
	assumes "\<SS> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	and "\<SS>' = cf_id \<DD>"
	and "\<AA> = \<DD>"
	and "\<BB> = \<DD>"
	shows "\<epsilon>\<^sub>C \<Phi> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	unfolding assms by (rule cf_adjunction_counit_is_ntcf)

	lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_is_ntcf'


	subsubsection\<open>Every component of a counit is a universal arrow\<close>

	text\<open>
	The lemmas in this subsection are based on elements of the statement of
	Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>

	lemma (in is_cf_adjunction) cf_adj_umap_fo_counit:
	assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "op_cf_adj \<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet> =
	umap_fo \<FF> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) a"
	by
	(
	rule is_cf_adjunction.cf_adj_umap_of_unit[
	OF is_cf_adjunction_op,
	unfolded cat_op_simps,
	OF assms,
	unfolded cf_adjunction_unit_NTMap_op
	]
	)

	lemma (in is_cf_adjunction) cf_adjunction_counit_component_is_ua_fo:
	assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	shows "universal_arrow_fo \<FF> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	by
	(
	rule is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
	OF is_cf_adjunction_op,
	unfolded cat_op_simps,
	OF assms,
	unfolded cf_adjunction_unit_NTMap_op
	]
	)


	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_cf_adjunction) cf_adj_AdjNT_cf_adjunction_unit:
	+ \<comment>\<open>See Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> a"
	+ shows
	+ "\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	+ (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+proof-
	+ from assms(1) have "\<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from cf_adj_Comp_commute_RL[OF assms(1) this assms(2)] assms show ?thesis
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp:
	+ cat_cs_simps
	+ is_cf_adjunction.cf_adjunction_unit_NTMap_app[symmetric]
	+ cs_intro: adj_cs_intros
	+ )
	+qed
	+
	+lemma (in is_cf_adjunction) cf_adj_AdjNT_cf_adjunction_counit:
	+ \<comment>\<open>See Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	+ shows
	+ "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
	+ (\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, x\<rparr>\<^sub>\<bullet>)\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	+ using
	+ is_cf_adjunction.cf_adj_AdjNT_cf_adjunction_unit
	+ [
	+ OF is_cf_adjunction_op,
	+ unfolded cat_op_simps cf_adjunction_unit_NTMap_op,
	+ OF assms
	+ ]
	+ assms
	+ by (slow)
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_cs_intros
	+ adj_cs_intros
	+ cat_op_intros
	+ cat_prod_cs_intros
	+ )
	+
	+lemma (in is_cf_adjunction) cf_adj_counit_unit_app[adj_cs_simps]:
	+ \<comment>\<open>See Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	+ shows "\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = g"
	+proof-
	+ from assms(2) have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ from assms have inv_\<Phi>_g:
	+ "(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>a, x\<rparr>\<^sub>\<bullet>)\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> x"
	+ by (slow)
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ adj_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+ from assms show ?thesis
	+ unfolding
	+ cf_adj_AdjNT_cf_adjunction_counit[OF assms]
	+ cf_adj_AdjNT_cf_adjunction_unit[OF a inv_\<Phi>_g]
	+ by (slow)
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ adj_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_cf_adjunction.cf_adj_counit_unit_app
	+
	+lemma (in is_cf_adjunction) cf_adj_unit_counit_app[adj_cs_simps]:
	+ \<comment>\<open>See Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> a"
	+ shows "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> = f"
	+proof-
	+ from assms(2) have a: "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" by auto
	+ from assms have \<Phi>_f:
	+ "(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>x, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ adj_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+ from assms show ?thesis
	+ unfolding
	+ cf_adj_AdjNT_cf_adjunction_unit[OF assms]
	+ cf_adj_AdjNT_cf_adjunction_counit[OF a \<Phi>_f]
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ adj_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+qed
	+
	+lemmas [cat_cs_simps] = is_cf_adjunction.cf_adj_unit_counit_app
	+
	+

	subsection\<open>Counit-unit equations\<close>


	text\<open>
	The following equations appear as part of the statement of
	Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	These equations also appear in \cite{noauthor_wikipedia_2001},
	where they are named \<open>counit-unit equations\<close>.
	\<close>

	lemma (in is_cf_adjunction) cf_adjunction_counit_unit:
	"(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>\<^sub>C \<Phi>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) = ntcf_id \<GG>"
	(is \<open>(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) = ntcf_id \<GG>\<close>)
	proof(rule ntcf_eqI)
	from is_cf_adjunction_axioms show
	"(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) : \<GG> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	show "ntcf_id \<GG> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule is_functor.cf_ntcf_id_is_ntcf[OF RL.is_functor_axioms])
	from is_cf_adjunction_axioms have dom_lhs:
	"\<D>\<^sub>\<circ> (((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>))\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros
	)
	from is_cf_adjunction_axioms have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_id \<GG>\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
	show "((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>))\<lparr>NTMap\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	let ?\<phi>_aa = \<open>\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, a\<rparr>\<^sub>\<bullet>\<close>
	have "category \<alpha> (cat_Set \<alpha>)"
	by (rule category_cat_Set)
	from is_cf_adjunction_axioms prems
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	LR.is_functor_axioms RL.is_functor_axioms (speedup)
	category_cat_Set (speedup)
	have
	"?\<phi>_aa\<lparr>ArrVal\<rparr>\<lparr>?\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> =
	(?\<phi>_aa \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>_aa\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	\<Z>.cat_Set_Comp_ArrVal
	cat_Set_the_inverse[symmetric]
	cat_cs_simps adj_cs_simps cat_prod_cs_simps
	cs_intro:
	cat_arrow_cs_intros
	cat_cs_intros
	cat_op_intros
	adj_cs_intros
	cat_prod_cs_intros
	)
	- also from is_cf_adjunction_axioms prems
	+ also from
	+ is_cf_adjunction_axioms prems
	L.category_axioms R.category_axioms (speedup)
	L.category_op R.category_op (speedup)
	LR.is_functor_axioms RL.is_functor_axioms (speedup)
	category_cat_Set (speedup)
	have "\<dots> = \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	- cs_concl
	- cs_simp: cat_cs_simps category.cat_the_inverse_Comp_CId
	- cs_intro:
	- cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps
	+ cat_Set_components(1)
	+ category.cat_the_inverse_Comp_CId
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ cat_op_intros
	+ cat_prod_cs_intros
	)
	finally have [cat_cs_simps]:
	- "(\<Phi>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> =
	- \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	+ "?\<phi>_aa\<lparr>ArrVal\<rparr>\<lparr>?\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by simp
	from
	prems is_cf_adjunction_axioms
	L.category_axioms R.category_axioms (speedup)
	show "((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp:
	cat_Set_the_inverse[symmetric]
	cf_adj_Comp_commute_RL
	cat_cs_simps
	adj_cs_simps
	cat_prod_cs_simps
	cat_op_simps
	cs_intro:
	cat_arrow_cs_intros
	cat_cs_intros
	adj_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)

	qed (auto intro: cat_cs_intros)

	qed simp_all

	lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_counit_unit

	lemma (in is_cf_adjunction) cf_adjunction_unit_counit:
	"(\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>) = ntcf_id \<FF>"
	(is \<open>(?\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>) = ntcf_id \<FF>\<close>)
	proof-
	from is_cf_adjunction_axioms have \<FF>\<eta>:
	"\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	from is_cf_adjunction_axioms have \<epsilon>\<FF>:
	"?\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	from \<FF>\<eta> \<epsilon>\<FF> have \<epsilon>\<FF>_\<FF>\<eta>:
	"(?\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from
	is_cf_adjunction.cf_adjunction_counit_unit[
	OF is_cf_adjunction_op,
	unfolded
	op_ntcf_cf_adjunction_unit[symmetric]
	op_ntcf_cf_adjunction_counit[symmetric]
	op_ntcf_cf_ntcf_comp[symmetric]
	op_ntcf_ntcf_cf_comp[symmetric]
	op_ntcf_ntcf_vcomp[symmetric]
	op_ntcf_ntcf_vcomp[symmetric, OF \<epsilon>\<FF> \<FF>\<eta>]
	LR.cf_ntcf_id_op_cf
	]
	have
	"op_ntcf (op_ntcf ((?\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>))) =
	op_ntcf (op_ntcf (ntcf_id \<FF>))"
	by simp
	from this is_cf_adjunction_axioms \<epsilon>\<FF>_\<FF>\<eta> show ?thesis
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed

	lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_unit_counit



	subsection\<open>
	Construction of an adjunction from universal morphisms
	from objects to functors
	\<close>


	text\<open>
	The subsection presents the construction of an adjunction given
	a structured collection of universal morphisms from objects to functors.
	The content of this subsection follows the statement and the proof
	of Theorem 2-i in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>


	subsubsection\<open>
	The natural transformation associated with the adjunction
	constructed from universal morphisms from objects to functors
	\<close>

	definition cf_adjunction_AdjNT_of_unit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta> =
	[
	(\<lambda>cd\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>.
	umap_of \<GG> (cd\<lparr>0\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>cd\<lparr>0\<rparr>\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>cd\<lparr>0\<rparr>\<rparr>) (cd\<lparr>1\<^sub>\<nat>\<rparr>)),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>-,-),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomDom\<rparr>(-,\<GG>-),
	op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C (\<FF>\<lparr>HomCod\<rparr>),
	cat_Set \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_adjunction_AdjNT_of_unit_components:
	shows "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr> =
	(
	\<lambda>cd\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>.
	umap_of \<GG> (cd\<lparr>0\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>cd\<lparr>0\<rparr>\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>cd\<lparr>0\<rparr>\<rparr>) (cd\<lparr>1\<^sub>\<nat>\<rparr>)
	)"
	and "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>-,-)"
	and "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomDom\<rparr>(-,\<GG>-)"
	and "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTDGDom\<rparr> =
	op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C (\<FF>\<lparr>HomCod\<rparr>)"
	and "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding cf_adjunction_AdjNT_of_unit_def nt_field_simps
	by (simp_all add: nat_omega_simps)


	subsubsection\<open>Natural transformation map\<close>

	lemma cf_adjunction_AdjNT_of_unit_NTMap_vsv[adj_cs_intros]:
	"vsv (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>)"
	unfolding cf_adjunction_AdjNT_of_unit_components by simp

	lemma cf_adjunction_AdjNT_of_unit_NTMap_vdomain[adj_cs_simps]:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<D>\<^sub>\<circ> (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	proof-
	interpret is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(1))
	show ?thesis
	unfolding cf_adjunction_AdjNT_of_unit_components
	by (simp add: cat_cs_simps)
	qed

	lemma cf_adjunction_AdjNT_of_unit_NTMap_app[adj_cs_simps]:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	shows
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> =
	umap_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) d"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(1))
	from assms have "[c, d]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	then show "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr> \<lparr>c, d\<rparr>\<^sub>\<bullet> =
	umap_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) d"
	unfolding cf_adjunction_AdjNT_of_unit_components
	by (simp add: nat_omega_simps cat_cs_simps)
	qed

	lemma cf_adjunction_AdjNT_of_unit_NTMap_vrange:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<R>\<^sub>\<circ> (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	show ?thesis
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cf_adjunction_AdjNT_of_unit_NTMap_vdomain[OF assms(3)]
	)
	show "vsv (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>)"
	by (intro adj_cs_intros)
	fix cd assume prems: "cd \<in>\<^sub>\<circ> (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	then obtain c d where cd_def: "cd = [c, d]\<^sub>\<circ>"
	and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and d: "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	auto
	simp: cat_op_simps
	elim:
	cat_prod_2_ObjE[OF \<FF>.HomDom.category_op \<FF>.HomCod.category_axioms]
	)
	from assms c d show
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>\<lparr>cd\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	unfolding cd_def
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_cs_simps adj_cs_simps cs_intro: cat_cs_intros
	)
	qed
	qed


	subsubsection\<open>
	Adjunction constructed from universal morphisms
	from objects to functors is an adjunction
	\<close>

	lemma cf_adjunction_AdjNT_of_unit_is_ntcf:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) :
	op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-

	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(4))
	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<eta> by (rule assms(5))

	show ?thesis
	proof(intro is_ntcfI')

	show "vfsequence (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>)"
	unfolding cf_adjunction_AdjNT_of_unit_def by simp
	show "vcard (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>) = 5\<^sub>\<nat>"
	unfolding cf_adjunction_AdjNT_of_unit_def by (simp add: nat_omega_simps)
	from assms(2,3) show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) : op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) : op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	show "vsv (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>)"
	by (intro adj_cs_intros)
	from assms show
	"\<D>\<^sub>\<circ> (cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps adj_cs_simps)

	show "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>\<lparr>cd\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)\<lparr>ObjMap\<rparr>\<lparr>cd\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)\<lparr>ObjMap\<rparr>\<lparr>cd\<rparr>"
	if "cd \<in>\<^sub>\<circ> (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>" for cd
	proof-
	from that obtain c d
	where cd_def: "cd = [c, d]\<^sub>\<circ>" and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and d: "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	auto
	simp: cat_op_simps
	elim: cat_prod_2_ObjE[OF \<CC>.category_op \<DD>.category_axioms]
	)
	from assms c d show ?thesis
	unfolding cd_def
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed

	show
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>\<lparr>c'd'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>NTMap\<rparr>\<lparr>cd\<rparr>"
	if "gf : cd \<mapsto>\<^bsub>op_cat \<CC> \<times>\<^sub>C \<DD>\<^esub> c'd'" for cd c'd' gf
	proof-
	from that obtain g f c c' d d'
	where gf_def: "gf = [g, f]\<^sub>\<circ>"
	and cd_def: "cd = [c, d]\<^sub>\<circ>"
	and c'd'_def: "c'd' = [c', d']\<^sub>\<circ>"
	and g: "g : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and f: "f : d \<mapsto>\<^bsub>\<DD>\<^esub> d'"
	by
	(
	auto
	simp: cat_op_simps
	elim: cat_prod_2_is_arrE[OF \<CC>.category_op \<DD>.category_axioms]
	)
	from assms g f that show ?thesis
	unfolding gf_def cd_def c'd'_def
	by
	(
	cs_concl
	cs_simp: cf_umap_of_cf_hom_unit_commute adj_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	qed

	qed (auto simp: cf_adjunction_AdjNT_of_unit_components cat_cs_simps)

	qed

	lemma cf_adjunction_AdjNT_of_unit_is_ntcf'[adj_cs_intros]:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<SS> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)"
	and "\<SS>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)"
	and "\<AA> = op_cat \<CC> \<times>\<^sub>C \<DD>"
	and "\<BB> = cat_Set \<alpha>"
	shows "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	using assms(1-5) unfolding assms(6-9)
	by (rule cf_adjunction_AdjNT_of_unit_is_ntcf)


	subsubsection\<open>
	Adjunction constructed from universal morphisms from objects to functors
	\<close>

	definition cf_adjunction_of_unit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> =
	[\<FF>, \<GG>, cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_adjunction_of_unit_components:
	shows [adj_cs_simps]: "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>AdjLeft\<rparr> = \<FF>"
	and [adj_cs_simps]: "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>AdjRight\<rparr> = \<GG>"
	and "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>AdjNT\<rparr> =
	cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>"
	unfolding cf_adjunction_of_unit_def adj_field_simps
	by (simp_all add: nat_omega_simps)


	text\<open>Natural transformation map.\<close>

	lemma cf_adjunction_of_unit_AdjNT_NTMap_vdomain[adj_cs_simps]:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<D>\<^sub>\<circ> (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>) =
	(op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	using assms
	unfolding cf_adjunction_of_unit_components(3)
	by (rule cf_adjunction_AdjNT_of_unit_NTMap_vdomain)

	lemma cf_adjunction_of_unit_AdjNT_NTMap_app[adj_cs_simps]:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	shows
	"cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> =
	umap_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) d"
	using assms
	unfolding cf_adjunction_of_unit_components(3)
	by (rule cf_adjunction_AdjNT_of_unit_NTMap_app)


	text\<open>
	The adjunction constructed from universal morphisms from objects to
	functors is an adjunction.
	\<close>

	lemma cf_adjunction_of_unit_is_cf_adjunction:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>x. x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> universal_arrow_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	shows "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	proof-

	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(4))
	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<eta> by (rule assms(5))

	show caou_\<eta>: "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof
	(
	intro
	is_cf_adjunctionI[OF _ _ assms(1-4)]
	is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
	OF \<CC>.category_op \<DD>.category_axioms
	],
	unfold cat_op_simps cf_adjunction_of_unit_components
	)
	show caou_\<eta>: "cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) :
	op_cat \<CC> \<times>\<^sub>C \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	unfolding cf_adjunction_of_unit_components
	by (rule cf_adjunction_AdjNT_of_unit_is_ntcf[OF assms(1-5)])
	fix a assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	have ua_of_\<eta>a:
	"ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<circ>\<^sub>C\<^sub>F \<GG> :
	\<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	rule is_functor.cf_ntcf_ua_of_is_iso_ntcf[
	OF assms(4) assms(6)[OF prems]
	]
	)
	have [adj_cs_simps]:
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F =
	ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	proof(rule ntcf_eqI)
	from assms(1-5) caou_\<eta> prems show lhs:
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<circ>\<^sub>C\<^sub>F \<GG> :
	\<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	from ua_of_\<eta>a show rhs:
	"ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<circ>\<^sub>C\<^sub>F \<GG> :
	\<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: ntcf_cs_intros)
	from lhs have dom_lhs:
	"\<D>\<^sub>\<circ> ((cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) =
	\<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from lhs assms(4) have dom_rhs:
	"\<D>\<^sub>\<circ> (ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show
	"(cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> =
	ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix d assume prems': "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	from assms(3,4) prems prems' show
	"(cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>d\<rparr> =
	ntcf_ua_of \<alpha> \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	by (cs_concl cs_shallow cs_simp: adj_cs_simps cat_cs_simps)
	qed (simp_all add: bnt_proj_snd_NTMap_vsv \<GG>.ntcf_ua_of_NTMap_vsv)
	qed simp_all
	from assms(1-5) assms(6)[OF prems] prems show
	"cf_adjunction_AdjNT_of_unit \<alpha> \<FF> \<GG> \<eta>\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(\<FF>-,-)\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)\<^bsub>op_cat \<CC>,\<DD>\<^esub>(a,-)\<^sub>C\<^sub>F :
	\<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	qed (auto simp: cf_adjunction_of_unit_def nat_omega_simps)

	show "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	proof(rule ntcf_eqI)
	from caou_\<eta> show lhs:
	"\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) :
	cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_shallow cs_intro: adj_cs_intros)
	show rhs: "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: cat_cs_intros)
	from lhs have dom_lhs:
	"\<D>\<^sub>\<circ> (\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<eta>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>" by (auto simp: cat_cs_simps)
	show "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr> = \<eta>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from assms(1-5) prems caou_\<eta> show
	"\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	adj_cs_simps cat_cs_simps cf_adjunction_of_unit_components(3)
	cs_intro: cat_cs_intros
	)
	qed (auto intro: adj_cs_intros)
	qed simp_all

	qed



	subsection\<open>
	Construction of an adjunction from a functor and universal morphisms
	from objects to functors
	\<close>


	text\<open>
	The subsection presents the construction of an adjunction given
	a functor and a structured collection of universal morphisms
	from objects to functors.
	The content of this subsection follows the statement and the proof
	of Theorem 2-ii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>


	subsubsection\<open>Left adjoint\<close>

	definition cf_la_of_ra :: "(V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_la_of_ra F \<GG> \<eta> =
	[
	(\<lambda>x\<in>\<^sub>\<circ>\<GG>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. F x),
	(
	\<lambda>h\<in>\<^sub>\<circ>\<GG>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f'.
	f' : F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>) \<mapsto>\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>) \<and>
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> h =
	+ \<eta>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> h =
	(
	umap_of
	\<GG>
	(\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>)
	(F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>))
	- (\<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>\<rparr>)
	+ (\<eta>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>\<rparr>)
	(F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>))
	)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	),
	\<GG>\<lparr>HomCod\<rparr>,
	\<GG>\<lparr>HomDom\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_la_of_ra_components:
	shows "cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr> = (\<lambda>x\<in>\<^sub>\<circ>\<GG>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. F x)"
	and "cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>h\<in>\<^sub>\<circ>\<GG>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f'.
	f' : F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>) \<mapsto>\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>) \<and>
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> h =
	+ \<eta>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> h =
	(
	umap_of
	\<GG>
	(\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>)
	(F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>))
	- (\<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>\<rparr>)
	+ (\<eta>\<lparr>\<GG>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>h\<rparr>\<rparr>)
	(F (\<GG>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>h\<rparr>))
	)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	and "cf_la_of_ra F \<GG> \<eta>\<lparr>HomDom\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
	and "cf_la_of_ra F \<GG> \<eta>\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomDom\<rparr>"
	unfolding cf_la_of_ra_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda cf_la_of_ra_components(1)
	\|vsv cf_la_of_ra_ObjMap_vsv[adj_cs_intros]\|

	mk_VLambda (in is_functor)
	cf_la_of_ra_components(1)[where ?\<GG>=\<FF>, unfolded cf_HomCod]
	\|vdomain cf_la_of_ra_ObjMap_vdomain[adj_cs_simps]\|
	\|app cf_la_of_ra_ObjMap_app[adj_cs_simps]\|

	lemmas [adj_cs_simps] =
	is_functor.cf_la_of_ra_ObjMap_vdomain
	is_functor.cf_la_of_ra_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	mk_VLambda cf_la_of_ra_components(2)
	\|vsv cf_la_of_ra_ArrMap_vsv[adj_cs_intros]\|

	mk_VLambda (in is_functor)
	cf_la_of_ra_components(2)[where ?\<GG>=\<FF>, unfolded cf_HomCod cf_HomDom]
	\|vdomain cf_la_of_ra_ArrMap_vdomain[adj_cs_simps]\|
	\|app cf_la_of_ra_ArrMap_app\| (not for general use)

	lemmas [adj_cs_simps] = is_functor.cf_la_of_ra_ArrMap_vdomain

	lemma (in is_functor) cf_la_of_ra_ArrMap_app':
	assumes "h : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	shows
	"cf_la_of_ra F \<FF> \<eta>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> =
	(
	THE f'.
	f' : F a \<mapsto>\<^bsub>\<AA>\<^esub> F b \<and>
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> h = umap_of \<FF> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> h = umap_of \<FF> a (F a) (\<eta>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	proof-
	from assms have h: "h \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by (simp add: cat_cs_intros)
	from assms have h_Dom: "\<BB>\<lparr>Dom\<rparr>\<lparr>h\<rparr> = a" and h_Cod: "\<BB>\<lparr>Cod\<rparr>\<lparr>h\<rparr> = b"
	by (simp_all add: cat_cs_simps)
	show ?thesis by (rule cf_la_of_ra_ArrMap_app[OF h, unfolded h_Dom h_Cod])
	qed

	lemma cf_la_of_ra_ArrMap_app_unique:
	assumes "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	- and "universal_arrow_of \<GG> a (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	- and "universal_arrow_of \<GG> b (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	+ and "universal_arrow_of \<GG> a (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>a\<rparr>)"
	+ and "universal_arrow_of \<GG> b (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>b\<rparr>)"
	shows "cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : F a \<mapsto>\<^bsub>\<DD>\<^esub> F b"
	- and "\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of
	- \<GG> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ and "\<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f =
	+ umap_of \<GG> a (F a) (\<eta>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	and "\<And>f'.
	\<lbrakk>
	f' : F a \<mapsto>\<^bsub>\<DD>\<^esub> F b;
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of \<GG> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of \<GG> a (F a) (\<eta>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = f'"
	proof-

	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(1))

	from assms(2) have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (simp_all add: cat_cs_intros)
	note ua_\<eta>_a = \<GG>.universal_arrow_ofD[OF assms(3)]
	note ua_\<eta>_b = \<GG>.universal_arrow_ofD[OF assms(4)]
	from ua_\<eta>_b(2) have [cat_cs_intros]:
	- "\<lbrakk> c = b; c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr> \<rbrakk> \<Longrightarrow>
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	+ "\<lbrakk> c = b; c' = \<GG>\<lparr>ObjMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr> \<rbrakk> \<Longrightarrow> \<eta>\<lparr>b\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	for c c'
	by auto
	from assms(1,2) ua_\<eta>_a(2) have \<eta>a_f:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	+ "\<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(1,2) have lara_a: "cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = F a"
	and lara_b: "cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = F b"
	by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)+

	from theD
	[
	OF
	ua_\<eta>_a(3)[OF ua_\<eta>_b(1) \<eta>a_f, unfolded lara_a lara_b]
	\<GG>.cf_la_of_ra_ArrMap_app'[OF assms(2), of F \<eta>]
	]
	show "cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : F a \<mapsto>\<^bsub>\<DD>\<^esub> F b"
	- and "\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of
	- \<GG> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ and "\<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of
	+ \<GG> a (F a) (\<eta>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	and "\<And>f'.
	\<lbrakk>
	f' : F a \<mapsto>\<^bsub>\<DD>\<^esub> F b;
	- \<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of \<GG> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = umap_of \<GG> a (F a) (\<eta>\<lparr>a\<rparr>) (F b)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = f'"
	by blast+

	qed

	lemma cf_la_of_ra_ArrMap_app_is_arr[adj_cs_intros]:
	assumes "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	- and "universal_arrow_of \<GG> a (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	- and "universal_arrow_of \<GG> b (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	+ and "universal_arrow_of \<GG> a (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>a\<rparr>)"
	+ and "universal_arrow_of \<GG> b (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>b\<rparr>)"
	and "Fa = F a"
	and "Fb = F b"
	shows "cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : Fa \<mapsto>\<^bsub>\<DD>\<^esub> Fb"
	using assms(1-4) unfolding assms(5,6) by (rule cf_la_of_ra_ArrMap_app_unique)


	subsubsection\<open>
	An adjunction constructed from a functor and universal morphisms
	from objects to functors is an adjunction
	\<close>

	lemma cf_la_of_ra_is_functor:
	assumes "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> F c \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow>
	- universal_arrow_of \<GG> c (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	+ universal_arrow_of \<GG> c (cf_la_of_ra F \<GG> \<eta>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>c\<rparr>)"
	and "\<And>c c' h. h : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<Longrightarrow>
	- \<GG>\<lparr>ArrMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) =
	- (\<eta>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	+ \<GG>\<lparr>ArrMap\<rparr>\<lparr>cf_la_of_ra F \<GG> \<eta>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>c\<rparr> = \<eta>\<lparr>c'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	shows "cf_la_of_ra F \<GG> \<eta> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" (is \<open>?\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>\<close>)
	proof-

	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(1))

	show "cf_la_of_ra F \<GG> \<eta> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof(rule is_functorI')

	show "vfsequence ?\<FF>" unfolding cf_la_of_ra_def by auto
	show "vcard ?\<FF> = 4\<^sub>\<nat>"
	unfolding cf_la_of_ra_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (?\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold \<GG>.cf_la_of_ra_ObjMap_vdomain)
	fix x assume "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms(1) show "?\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: adj_cs_simps cs_intro: assms(2))
	qed (auto intro: adj_cs_intros)

	show "?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : ?\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> ?\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	proof-
	from that have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (simp_all add: cat_cs_intros)
	- have ua_\<eta>_a: "universal_arrow_of \<GG> a (?\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	- and ua_\<eta>_b: "universal_arrow_of \<GG> b (?\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	+ have ua_\<eta>_a: "universal_arrow_of \<GG> a (?\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<eta>\<lparr>a\<rparr>)"
	+ and ua_\<eta>_b: "universal_arrow_of \<GG> b (?\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<eta>\<lparr>b\<rparr>)"
	by (intro assms(3)[OF a] assms(3)[OF b])+
	from a b cf_la_of_ra_ArrMap_app_unique(1)[OF assms(1) that ua_\<eta>_a ua_\<eta>_b]
	show ?thesis
	by (cs_concl cs_shallow cs_simp: adj_cs_simps)
	qed

	show "?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = ?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> ?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for b c g a f
	proof-

	from that have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (simp_all add: cat_cs_intros)
	from assms(1) that have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	note ua_\<eta>_a = assms(3)[OF a]
	and ua_\<eta>_b = assms(3)[OF b]
	and ua_\<eta>_c = assms(3)[OF c]

	note lara_f =
	cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(2) ua_\<eta>_a ua_\<eta>_b]
	note lara_g =
	cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(1) ua_\<eta>_b ua_\<eta>_c]
	note lara_gf =
	cf_la_of_ra_ArrMap_app_unique[OF assms(1) gf ua_\<eta>_a ua_\<eta>_c]

	note ua_\<eta>_a = \<GG>.universal_arrow_ofD[OF ua_\<eta>_a]
	and ua_\<eta>_b = \<GG>.universal_arrow_ofD[OF ua_\<eta>_b]
	and ua_\<eta>_c = \<GG>.universal_arrow_ofD[OF ua_\<eta>_c]

	from ua_\<eta>_a(2) assms(1) that have \<eta>a:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F a\<rparr>"
	+ "\<eta>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F a\<rparr>"
	by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
	from ua_\<eta>_b(2) assms(1) that have \<eta>b:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F b\<rparr>"
	+ "\<eta>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F b\<rparr>"
	by (cs_prems cs_shallow cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
	from ua_\<eta>_c(2) assms(1) that have \<eta>c:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F c\<rparr>"
	+ "\<eta>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F c\<rparr>"
	by (cs_prems cs_shallow cs_simp: adj_cs_simps cs_intro: cat_cs_intros)

	from assms(1) that \<eta>c have
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ "\<eta>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = (\<eta>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- also from assms(1) lara_g(1) that(2) \<eta>b have "\<dots> =
	- \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	+ also from assms(1) lara_g(1) that(2) \<eta>b have
	+ "\<dots> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	by
	(
	cs_concl
	cs_simp: lara_g(2) cat_cs_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	also from assms(1) lara_f(1) \<eta>a have "\<dots> =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	- (\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	+ (\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>a\<rparr>)"
	by (cs_concl cs_shallow cs_simp: lara_f(2) cat_cs_simps)
	finally have [symmetric, cat_cs_simps]:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = \<dots>".
	+ "\<eta>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = \<dots>".
	from assms(1) this \<eta>a \<eta>b \<eta>c lara_g(1) lara_f(1) have
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) =
	- umap_of \<GG> a (F a) (\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (F c)\<lparr>ArrVal\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	+ "\<eta>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) =
	+ umap_of \<GG> a (F a) (\<eta>\<lparr>a\<rparr>) (F c)\<lparr>ArrVal\<rparr>\<lparr>?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	moreover from assms(1) lara_g(1) lara_f(1) have
	"?\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> ?\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : F a \<mapsto>\<^bsub>\<DD>\<^esub> F c"
	by (cs_concl cs_shallow cs_intro: adj_cs_intros cat_cs_intros)
	ultimately show ?thesis by (intro lara_gf(3))

	qed

	show "?\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<DD>\<lparr>CId\<rparr>\<lparr>?\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>" if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	proof-
	note lara_c = cf_la_of_ra_ArrMap_app_unique[
	OF
	assms(1)
	\<GG>.HomCod.cat_CId_is_arr[OF that]
	assms(3)[OF that]
	assms(3)[OF that]
	]
	from assms(1) that have \<DD>c: "\<DD>\<lparr>CId\<rparr>\<lparr>F c\<rparr> : F c \<mapsto>\<^bsub>\<DD>\<^esub> F c "
	by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
	from \<GG>.universal_arrow_ofD(2)[OF assms(3)[OF that]] assms(1) that have \<eta>c:
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F c\<rparr>"
	+ "\<eta>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>F c\<rparr>"
	by (cs_prems cs_shallow cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
	from assms(1) that \<eta>c have
	- "\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> =
	- umap_of \<GG> c (F c) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) (F c)\<lparr>ArrVal\<rparr>\<lparr>\<DD>\<lparr>CId\<rparr>\<lparr>F c\<rparr>\<rparr>"
	+ "\<eta>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> =
	+ umap_of \<GG> c (F c) (\<eta>\<lparr>c\<rparr>) (F c)\<lparr>ArrVal\<rparr>\<lparr>\<DD>\<lparr>CId\<rparr>\<lparr>F c\<rparr>\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
	note [cat_cs_simps] = lara_c(3)[OF \<DD>c this]
	from assms(1) that \<DD>c show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	)
	qed
	qed (auto simp: cf_la_of_ra_components cat_cs_intros cat_cs_simps)

	qed

	lemma cf_la_of_ra_is_ntcf:
	- fixes F \<GG> \<eta>
	- defines "\<FF> \<equiv> cf_la_of_ra F \<GG> \<eta>"
	+ fixes F \<CC> \<FF> \<GG> \<eta>\<^sub>m \<eta>
	+ defines "\<FF> \<equiv> cf_la_of_ra F \<GG> \<eta>\<^sub>m"
	+ and "\<eta> \<equiv> [\<eta>\<^sub>m, cf_id \<CC>, \<GG> \<circ>\<^sub>C\<^sub>F \<FF>, \<CC>, \<CC>]\<^sub>\<circ>"
	assumes "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> F c \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	- and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow>
	- universal_arrow_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	+ and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> universal_arrow_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	and "\<And>c c' h. h : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<Longrightarrow>
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) = (\<eta>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	- and "vfsequence \<eta>"
	- and "vcard \<eta> = 5\<^sub>\<nat>"
	- and "\<eta>\<lparr>NTDom\<rparr> = cf_id \<CC>"
	- and "\<eta>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	- and "\<eta>\<lparr>NTDGDom\<rparr> = \<CC>"
	- and "\<eta>\<lparr>NTDGCod\<rparr> = \<CC>"
	and "vsv (\<eta>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<eta>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	shows "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-
	- interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(2))
	+ interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(3))
	+ have \<eta>_components:
	+ "\<eta>\<lparr>NTMap\<rparr> = \<eta>\<^sub>m"
	+ "\<eta>\<lparr>NTDom\<rparr> = cf_id \<CC>"
	+ "\<eta>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ "\<eta>\<lparr>NTDGDom\<rparr> = \<CC>"
	+ "\<eta>\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding \<eta>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+ note \<FF>_def = \<FF>_def[folded \<eta>_components(1)]
	have \<FF>: "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	unfolding \<FF>_def
	- by (auto intro: cf_la_of_ra_is_functor[OF assms(2-5)[unfolded assms(1)]])
	+ by (auto intro: cf_la_of_ra_is_functor[OF assms(3-6)[unfolded \<FF>_def]])
	show "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(rule is_ntcfI')
	+ show "vfsequence \<eta>" unfolding \<eta>_def by simp
	+ show "vcard \<eta> = 5\<^sub>\<nat>" unfolding \<eta>_def by (simp_all add: nat_omega_simps)
	from assms(2) show "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(2) \<FF> show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	- using assms(2) \<FF> that \<GG>.universal_arrow_ofD(2)[OF assms(4)[OF that]]
	+ using assms(2) \<FF> that \<GG>.universal_arrow_ofD(2)[OF assms(5)[OF that]]
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show
	"\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_id \<CC>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	- using assms(2) \<FF> that
	+ using assms(3) \<FF> that
	by
	(
	cs_concl cs_shallow
	- cs_simp: assms(5) cat_cs_simps cs_intro: cat_cs_intros
	+ cs_simp: assms(6) cat_cs_simps cs_intro: cat_cs_intros
	)
	- qed (auto intro: assms(6-13))
	+ qed (auto simp: \<eta>_components(2-5) assms(7-8))
	qed

	lemma cf_la_of_ra_is_unit:
	- fixes F \<GG> \<eta>
	- defines "\<FF> \<equiv> cf_la_of_ra F \<GG> \<eta>"
	+ fixes F \<CC> \<FF> \<GG> \<eta>\<^sub>m \<eta>
	+ defines "\<FF> \<equiv> cf_la_of_ra F \<GG> \<eta>\<^sub>m"
	+ and "\<eta> \<equiv> [\<eta>\<^sub>m, cf_id \<CC>, \<GG> \<circ>\<^sub>C\<^sub>F \<FF>, \<CC>, \<CC>]\<^sub>\<circ>"
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> F c \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow>
	universal_arrow_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	and "\<And>c c' h. h : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<Longrightarrow>
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) = (\<eta>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
	- and "vfsequence \<eta>"
	- and "vcard \<eta> = 5\<^sub>\<nat>"
	- and "\<eta>\<lparr>NTDom\<rparr> = cf_id \<CC>"
	- and "\<eta>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	- and "\<eta>\<lparr>NTDGDom\<rparr> = \<CC>"
	- and "\<eta>\<lparr>NTDGCod\<rparr> = \<CC>"
	and "vsv (\<eta>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<eta>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	shows "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	proof-
	- note \<FF> = cf_la_of_ra_is_functor[
	- where F=F and \<eta>=\<eta>, OF assms(4-7)[unfolded \<FF>_def], simplified
	+ have \<eta>_components:
	+ "\<eta>\<lparr>NTMap\<rparr> = \<eta>\<^sub>m"
	+ "\<eta>\<lparr>NTDom\<rparr> = cf_id \<CC>"
	+ "\<eta>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F \<FF>"
	+ "\<eta>\<lparr>NTDGDom\<rparr> = \<CC>"
	+ "\<eta>\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding \<eta>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+ note \<FF>_def = \<FF>_def[folded \<eta>_components(1)]
	+ note \<FF> = cf_la_of_ra_is_functor
	+ [
	+ where F=F and \<CC>=\<CC> and \<GG>=\<GG> and \<eta>=\<eta>\<^sub>m,
	+ folded \<FF>_def[unfolded \<eta>_components(1)],
	+ folded \<eta>_components(1),
	+ OF assms(5-8),
	+ simplified
	]
	- note \<eta> = cf_la_of_ra_is_ntcf[OF assms(4-15)[unfolded \<FF>_def], simplified]
	+ note \<eta> = cf_la_of_ra_is_ntcf
	+ [
	+ where F=F and \<CC>=\<CC> and \<GG>=\<GG> and \<eta>\<^sub>m=\<eta>\<^sub>m,
	+ folded \<FF>_def[unfolded \<eta>_components(1)],
	+ folded \<eta>_def,
	+ OF assms(5-10),
	+ simplified
	+ ]
	show "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	by
	(
	- intro
	- cf_adjunction_of_unit_is_cf_adjunction
	- [
	- OF assms(2,3) \<FF> assms(4) \<eta> assms(6)[unfolded \<FF>_def],
	- simplified,
	- folded \<FF>_def
	- ]
	+ intro cf_adjunction_of_unit_is_cf_adjunction[
	+ OF assms(3,4) \<FF> assms(5) \<eta> assms(7), simplified, folded \<FF>_def
	+ ]
	)+
	qed



	subsection\<open>
	Construction of an adjunction from universal morphisms
	from functors to objects
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The subsection presents the construction of an adjunction given
	a structured collection of universal morphisms from functors to objects.
	The content of this subsection follows the statement and the proof
	of Theorem 2-iii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>

	definition cf_adjunction_of_counit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> =
	op_cf_adj (cf_adjunction_of_unit \<alpha> (op_cf \<GG>) (op_cf \<FF>) (op_ntcf \<epsilon>))"


	text\<open>Components.\<close>

	lemma cf_adjunction_of_counit_components:
	shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjLeft\<rparr> = op_cf (op_cf \<FF>)"
	and "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjRight\<rparr> = op_cf (op_cf \<GG>)"
	and "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr> = op_cf_adj_nt
	(op_cf \<GG>\<lparr>HomDom\<rparr>)
	(op_cf \<GG>\<lparr>HomCod\<rparr>)
	(cf_adjunction_AdjNT_of_unit \<alpha> (op_cf \<GG>) (op_cf \<FF>) (op_ntcf \<epsilon>))"
	unfolding
	cf_adjunction_of_counit_def
	op_cf_adj_components
	cf_adjunction_of_unit_components
	by (simp_all add: cat_op_simps)


	subsubsection\<open>Natural transformation map\<close>

	lemma cf_adjunction_of_counit_NTMap_vsv:
	"vsv (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>)"
	unfolding cf_adjunction_of_counit_components by (rule inv_ntcf_NTMap_vsv)



	subsubsection\<open>
	An adjunction constructed from universal morphisms
	from functors to objects is an adjunction
	\<close>

	lemma cf_adjunction_of_counit_is_cf_adjunction:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>x. x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow> universal_arrow_fo \<FF> x (\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	and "\<D>\<^sub>\<circ> (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>) =
	(op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	and "\<And>c d. \<lbrakk> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> =
	(umap_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>) c)\<inverse>\<^sub>S\<^sub>e\<^sub>t"
	proof-

	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(4))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<epsilon> by (rule assms(5))

	note cf_adjunction_of_counit_def' =
	cf_adjunction_of_counit_def[where \<FF>=\<FF>, unfolded \<FF>.cf_HomDom \<FF>.cf_HomCod]

	have ua:
	"universal_arrow_of (op_cf \<FF>) x (op_cf \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (op_ntcf \<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	if "x \<in>\<^sub>\<circ> op_cat \<DD>\<lparr>Obj\<rparr>" for x
	using that unfolding cat_op_simps by (rule assms(6))

	let ?aou = \<open>cf_adjunction_of_unit \<alpha> (op_cf \<GG>) (op_cf \<FF>) (op_ntcf \<epsilon>)\<close>
	from
	cf_adjunction_of_unit_is_cf_adjunction
	[
	OF
	\<DD>.category_op
	\<CC>.category_op
	\<GG>.is_functor_op
	\<FF>.is_functor_op
	\<epsilon>.is_ntcf_op[unfolded cat_op_simps]
	ua,
	simplified cf_adjunction_of_counit_def[symmetric]
	]
	have aou: "?aou : op_cf \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<DD> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	and \<eta>_aou: "\<eta>\<^sub>C ?aou = op_ntcf \<epsilon>"
	by auto
	interpret aou:
	is_cf_adjunction \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> ?aou
	by (rule aou)
	from \<eta>_aou have
	"op_ntcf (\<eta>\<^sub>C ?aou) = op_ntcf (op_ntcf \<epsilon>)"
	by simp
	then show "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	unfolding
	\<epsilon>.ntcf_op_ntcf_op_ntcf
	is_cf_adjunction.op_ntcf_cf_adjunction_unit[OF aou]
	cf_adjunction_of_counit_def'[symmetric]
	by (simp add: cat_op_simps)
	show aoc_\<epsilon>: "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by
	(
	rule
	is_cf_adjunction_op[
	OF aou, folded cf_adjunction_of_counit_def', unfolded cat_op_simps
	]
	)
	interpret aoc_\<epsilon>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<open>cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<close>
	by (rule aoc_\<epsilon>)

	from aoc_\<epsilon>.NT.is_ntcf_axioms show
	"\<D>\<^sub>\<circ> (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<DD>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show "\<And>c d. \<lbrakk> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>; d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
	cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> =
	(umap_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>) c)\<inverse>\<^sub>S\<^sub>e\<^sub>t"
	proof-
	fix c d assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	from assms(1-4) prems have aou_dc:
	"cf_adjunction_AdjNT_of_unit
	\<alpha> (op_cf \<GG>) (op_cf \<FF>) (op_ntcf \<epsilon>)\<lparr>NTMap\<rparr>\<lparr>d, c\<rparr>\<^sub>\<bullet> =
	umap_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>) c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps adj_cs_simps cs_intro: cat_op_intros
	)
	from assms(1-4) aou prems have ufo_\<epsilon>_dc:
	"umap_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>) c :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(op_cf \<GG>-,-)\<lparr>ObjMap\<rparr>\<lparr>d, c\<rparr>\<^sub>\<bullet> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<DD>(-,op_cf \<FF>-)\<lparr>ObjMap\<rparr>\<lparr>d, c\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	aou_dc[symmetric] cf_adjunction_of_unit_components(3)[symmetric]
	cs_intro:
	- is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
	+ is_iso_ntcf.iso_ntcf_is_iso_arr'
	adj_cs_intros
	cat_cs_intros
	cat_op_intros
	cat_prod_cs_intros
	)
	from
	assms(1-4)
	aoc_\<epsilon>[unfolded cf_adjunction_of_counit_def']
	aou
	prems
	ufo_\<epsilon>_dc
	show
	"cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<lparr>AdjNT\<rparr>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> =
	(umap_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>) c)\<inverse>\<^sub>S\<^sub>e\<^sub>t"
	unfolding cf_adjunction_of_counit_def'
	by
	(
	cs_concl
	cs_simp: cat_op_simps adj_cs_simps cat_cs_simps cat_Set_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros cat_prod_cs_intros
	)
	qed

	qed



	subsection\<open>
	Construction of an adjunction from a functor and universal morphisms
	from functors to objects
	\<close>


	text\<open>
	The subsection presents the construction of an adjunction given
	a functor and a structured collection of universal morphisms
	from functors to objects.
	The content of this subsection follows the statement and the proof
	of Theorem 2-iv in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition cf_ra_of_la :: "(V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	- where "cf_ra_of_la F \<FF> \<epsilon> = op_cf (cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>))"
	+ where "cf_ra_of_la F \<FF> \<epsilon> = op_cf (cf_la_of_ra F (op_cf \<FF>) \<epsilon>)"


	subsubsection\<open>Object map\<close>

	lemma cf_ra_of_la_ObjMap_vsv[adj_cs_intros]: "vsv (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>)"
	unfolding cf_ra_of_la_def op_cf_components by (auto intro: adj_cs_intros)

	lemma (in is_functor) cf_ra_of_la_ObjMap_vdomain:
	"\<D>\<^sub>\<circ> (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
	by (simp add: cat_cs_simps)

	lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_vdomain

	lemma (in is_functor) cf_ra_of_la_ObjMap_app:
	assumes "d \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> = F d"
	using assms
	unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
	by (simp add: cat_cs_simps)

	lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_app


	subsubsection\<open>Arrow map\<close>

	lemma cf_ra_of_la_ArrMap_app_unique:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> b"
	- and "universal_arrow_fo \<FF> a (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	- and "universal_arrow_fo \<FF> b (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	+ and "universal_arrow_fo \<FF> a (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<epsilon>\<lparr>a\<rparr>)"
	+ and "universal_arrow_fo \<FF> b (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<epsilon>\<lparr>b\<rparr>)"
	shows "cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : F a \<mapsto>\<^bsub>\<CC>\<^esub> F b"
	- and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	- umap_fo \<FF> b (F b) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>a\<rparr> =
	+ umap_fo \<FF> b (F b) (\<epsilon>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	and "\<And>f'.
	\<lbrakk>
	f' : F a \<mapsto>\<^bsub>\<CC>\<^esub> F b;
	- f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = umap_fo \<FF> b (F b) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>a\<rparr> = umap_fo \<FF> b (F b) (\<epsilon>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = f'"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(1))
	from assms(2) have op_f: "f : b \<mapsto>\<^bsub>op_cat \<DD>\<^esub> a" unfolding cat_op_simps by simp
	- let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)\<close>
	+ let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) \<epsilon>\<close>
	have lara_ObjMap_eq_op: "?lara\<lparr>ObjMap\<rparr> = (op_cf ?lara\<lparr>ObjMap\<rparr>)"
	and lara_ArrMap_eq_op: "?lara\<lparr>ArrMap\<rparr> = (op_cf ?lara\<lparr>ArrMap\<rparr>)"
	unfolding cat_op_simps by simp_all
	note ua_\<eta>_a = \<FF>.universal_arrow_foD[OF assms(3)]
	and ua_\<eta>_b = \<FF>.universal_arrow_foD[OF assms(4)]
	from assms(1,2) ua_\<eta>_a(2) have [cat_op_simps]:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> f = f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ "\<epsilon>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> f = f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_op_simps)
	show "cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : F a \<mapsto>\<^bsub>\<CC>\<^esub> F b"
	- and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	- umap_fo \<FF> b (F b) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>a\<rparr> =
	+ umap_fo \<FF> b (F b) (\<epsilon>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
	and "\<And>f'.
	\<lbrakk>
	f' : F a \<mapsto>\<^bsub>\<CC>\<^esub> F b;
	- f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = umap_fo \<FF> b (F b) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>a\<rparr> = umap_fo \<FF> b (F b) (\<epsilon>\<lparr>b\<rparr>) (F a)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = f'"
	by
	(
	intro
	cf_la_of_ra_ArrMap_app_unique
	[
	- where \<eta>=\<open>op_ntcf \<epsilon>\<close> and F=F,
	+ where \<eta>=\<epsilon> and F=F,
	OF \<FF>.is_functor_op op_f,
	unfolded
	\<FF>.op_cf_universal_arrow_of
	lara_ObjMap_eq_op
	lara_ArrMap_eq_op,
	folded cf_ra_of_la_def,
	- unfolded cat_op_simps,
	- OF assms(4,3)
	+ unfolded cat_op_simps, OF assms(4,3)
	]
	)+
	qed

	lemma cf_ra_of_la_ArrMap_app_is_arr[adj_cs_intros]:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> b"
	- and "universal_arrow_fo \<FF> a (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	- and "universal_arrow_fo \<FF> b (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	+ and "universal_arrow_fo \<FF> a (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<epsilon>\<lparr>a\<rparr>)"
	+ and "universal_arrow_fo \<FF> b (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<epsilon>\<lparr>b\<rparr>)"
	and "Fa = F a"
	and "Fb = F b"
	shows "cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : Fa \<mapsto>\<^bsub>\<CC>\<^esub> Fb"
	using assms(1-4) unfolding assms(5,6) by (rule cf_ra_of_la_ArrMap_app_unique)


	subsubsection\<open>
	An adjunction constructed from a functor and universal morphisms
	from functors to objects is an adjunction
	\<close>

	lemma op_cf_cf_la_of_ra_op[cat_op_simps]:
	- "op_cf (cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)) = cf_ra_of_la F \<FF> \<epsilon>"
	+ "op_cf (cf_la_of_ra F (op_cf \<FF>) \<epsilon>) = cf_ra_of_la F \<FF> \<epsilon>"
	unfolding cf_ra_of_la_def by simp

	lemma cf_ra_of_la_commute_op:
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow>
	- universal_arrow_fo \<FF> d (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>)"
	+ universal_arrow_fo \<FF> d (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>d\<rparr>)"
	and "\<And>d d' h. h : d \<mapsto>\<^bsub>\<DD>\<^esub> d' \<Longrightarrow>
	- \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> =
	- h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	+ \<epsilon>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> =
	+ h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>d\<rparr>"
	and "h : c' \<mapsto>\<^bsub>\<DD>\<^esub> c"
	- shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	- \<epsilon>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> h"
	+ shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> \<epsilon>\<lparr>c\<rparr> =
	+ \<epsilon>\<lparr>c'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> h"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(1))
	from assms(4) have c': "c' \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" by auto
	note ua_\<eta>_c' = \<FF>.universal_arrow_foD[OF assms(2)[OF c']]
	and ua_\<eta>_c = \<FF>.universal_arrow_foD[OF assms(2)[OF c]]
	note rala_f = cf_ra_of_la_ArrMap_app_unique[
	OF assms(1) assms(4) assms(2)[OF c'] assms(2)[OF c]
	]
	from assms(1) assms(4) ua_\<eta>_c'(2) ua_\<eta>_c(2) rala_f(1) show ?thesis
	by
	(
	cs_concl cs_shallow
	cs_simp: assms(3) cat_op_simps adj_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros
	)
	qed

	lemma
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow> F d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow>
	- universal_arrow_fo \<FF> d (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>)"
	+ universal_arrow_fo \<FF> d (cf_ra_of_la F \<FF> \<epsilon>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>d\<rparr>)"
	and "\<And>d d' h. h : d \<mapsto>\<^bsub>\<DD>\<^esub> d' \<Longrightarrow>
	- \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> =
	- h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	+ \<epsilon>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> =
	+ h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>d\<rparr>"
	shows cf_ra_of_la_is_functor: "cf_ra_of_la F \<FF> \<epsilon> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and cf_la_of_ra_op_is_functor:
	- "cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>) : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ "cf_la_of_ra F (op_cf \<FF>) \<epsilon> : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	proof-
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(1))
	- have \<FF>h_\<epsilon>c:
	- "\<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	- \<epsilon>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> h"
	+ have \<FF>h_\<epsilon>c:
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>cf_ra_of_la F \<FF> \<epsilon>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> \<epsilon>\<lparr>c\<rparr> =
	+ \<epsilon>\<lparr>c'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<DD>\<^esub> h"
	if "h : c' \<mapsto>\<^bsub>\<DD>\<^esub> c" for c c' h
	proof-
	from that have c': "c' \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" by auto
	note ua_\<eta>_c' = \<FF>.universal_arrow_foD[OF assms(3)[OF c']]
	and ua_\<eta>_c = \<FF>.universal_arrow_foD[OF assms(3)[OF c]]
	note rala_f = cf_ra_of_la_ArrMap_app_unique[
	OF assms(1) that assms(3)[OF c'] assms(3)[OF c]
	]
	from assms(1) that ua_\<eta>_c'(2) ua_\<eta>_c(2) rala_f(1) show ?thesis
	- by
	+ by
	(
	cs_concl cs_shallow
	cs_simp: assms(4) cat_op_simps adj_cs_simps cat_cs_simps
	cs_intro: cat_cs_intros
	)
	qed
	- let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)\<close>
	+ let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) \<epsilon>\<close>
	have lara_ObjMap_eq_op: "?lara\<lparr>ObjMap\<rparr> = (op_cf ?lara\<lparr>ObjMap\<rparr>)"
	and lara_ArrMap_eq_op: "?lara\<lparr>ArrMap\<rparr> = (op_cf ?lara\<lparr>ArrMap\<rparr>)"
	by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
	- show "cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>) : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ show "cf_la_of_ra F (op_cf \<FF>) \<epsilon> : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by
	(
	intro cf_la_of_ra_is_functor
	[
	- where F=F and \<eta>=\<open>op_ntcf \<epsilon>\<close>,
	+ where F=F and \<eta>=\<epsilon>,
	OF \<FF>.is_functor_op,
	unfolded cat_op_simps,
	OF assms(2),
	simplified,
	unfolded lara_ObjMap_eq_op lara_ArrMap_eq_op,
	folded cf_ra_of_la_def,
	- OF assms(3) \<FF>h_\<epsilon>c
	+ OF assms(3) \<FF>h_\<epsilon>c,
	+ simplified
	]
	)
	from
	is_functor.is_functor_op[
	OF this, unfolded cat_op_simps, folded cf_ra_of_la_def
	]
	show "cf_ra_of_la F \<FF> \<epsilon> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>".
	qed

	-lemma cf_ra_of_la_is_ntcf:
	- fixes F \<FF> \<epsilon>
	- defines "\<GG> \<equiv> cf_ra_of_la F \<FF> \<epsilon>"
	+lemma cf_ra_of_la_is_ntcf:
	+ fixes F \<DD> \<FF> \<GG> \<epsilon>\<^sub>m \<epsilon>
	+ defines "\<GG> \<equiv> cf_ra_of_la F \<FF> \<epsilon>\<^sub>m"
	+ and "\<epsilon> \<equiv> [\<epsilon>\<^sub>m, \<FF> \<circ>\<^sub>C\<^sub>F \<GG>, cf_id \<DD>, \<DD>, \<DD>]\<^sub>\<circ>"
	assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow> F d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow>
	universal_arrow_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>)"
	and "\<And>d d' h. h : d \<mapsto>\<^bsub>\<DD>\<^esub> d' \<Longrightarrow>
	\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> = h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	- and "vfsequence \<epsilon>"
	- and "vcard \<epsilon> = 5\<^sub>\<nat>"
	- and "\<epsilon>\<lparr>NTDom\<rparr> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	- and "\<epsilon>\<lparr>NTCod\<rparr> = cf_id \<DD>"
	- and "\<epsilon>\<lparr>NTDGDom\<rparr> = \<DD>"
	- and "\<epsilon>\<lparr>NTDGCod\<rparr> = \<DD>"
	and "vsv (\<epsilon>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<epsilon>\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	shows "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	-
	- interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
	+ interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	+ have \<epsilon>_components:
	+ "\<epsilon>\<lparr>NTMap\<rparr> = \<epsilon>\<^sub>m"
	+ "\<epsilon>\<lparr>NTDom\<rparr> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	+ "\<epsilon>\<lparr>NTCod\<rparr> = cf_id \<DD>"
	+ "\<epsilon>\<lparr>NTDGDom\<rparr> = \<DD>"
	+ "\<epsilon>\<lparr>NTDGCod\<rparr> = \<DD>"
	+ unfolding \<epsilon>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+ note \<GG>_def = \<GG>_def[folded \<epsilon>_components(1)]
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG>
	unfolding \<GG>_def
	- by (auto intro: cf_ra_of_la_is_functor[OF assms(2-5)[unfolded assms(1)]])
	+ by (auto intro: cf_ra_of_la_is_functor[OF assms(3-6)[unfolded \<GG>_def]])
	interpret op_\<epsilon>: is_functor
	- \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)\<close>
	+ \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>cf_la_of_ra F (op_cf \<FF>) (\<epsilon>\<lparr>NTMap\<rparr>)\<close>
	by
	(
	intro cf_la_of_ra_op_is_functor[
	- where F=F and \<epsilon>=\<epsilon>, OF assms(2,3,4,5)[unfolded \<GG>_def], simplified
	+ where F=F and \<epsilon>=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<close>, OF assms(3-6)[unfolded \<GG>_def], simplified
	]
	)
	- interpret \<epsilon>: vfsequence \<epsilon> by (rule assms(6))
	-
	+ interpret \<epsilon>: vfsequence \<epsilon> unfolding \<epsilon>_def by simp
	have [cat_op_simps]: "op_ntcf (op_ntcf \<epsilon>) = \<epsilon>"
	proof(rule vsv_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_ntcf (op_ntcf \<epsilon>)) = 5\<^sub>\<nat>"
	unfolding op_ntcf_def by (simp add: nat_omega_simps)
	from assms(7) show "\<D>\<^sub>\<circ> (op_ntcf (op_ntcf \<epsilon>)) = \<D>\<^sub>\<circ> \<epsilon>"
	- by (simp add: dom_lhs \<epsilon>.vfsequence_vdomain)
	+ unfolding dom_lhs by (simp add: \<epsilon>_def \<epsilon>.vfsequence_vdomain nat_omega_simps)
	have sup:
	"op_ntcf (op_ntcf \<epsilon>)\<lparr>NTDom\<rparr> = \<epsilon>\<lparr>NTDom\<rparr>"
	"op_ntcf (op_ntcf \<epsilon>)\<lparr>NTCod\<rparr> = \<epsilon>\<lparr>NTCod\<rparr>"
	"op_ntcf (op_ntcf \<epsilon>)\<lparr>NTDGDom\<rparr> = \<epsilon>\<lparr>NTDGDom\<rparr>"
	"op_ntcf (op_ntcf \<epsilon>)\<lparr>NTDGCod\<rparr> = \<epsilon>\<lparr>NTDGCod\<rparr>"
	- unfolding op_ntcf_components assms(8-11) cat_op_simps
	+ unfolding op_ntcf_components cat_op_simps \<epsilon>_components
	by simp_all
	show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_ntcf (op_ntcf \<epsilon>)) \<Longrightarrow> op_ntcf (op_ntcf \<epsilon>)\<lparr>a\<rparr> = \<epsilon>\<lparr>a\<rparr>" for a
	by (unfold dom_lhs, elim_in_numeral, fold nt_field_simps, unfold sup)
	(simp_all add: cat_op_simps)
	qed (auto simp: op_ntcf_def)
	-
	- let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)\<close>
	+ let ?lara = \<open>cf_la_of_ra F (op_cf \<FF>) (\<epsilon>\<lparr>NTMap\<rparr>)\<close>
	have lara_ObjMap_eq_op: "?lara\<lparr>ObjMap\<rparr> = (op_cf ?lara\<lparr>ObjMap\<rparr>)"
	and lara_ArrMap_eq_op: "?lara\<lparr>ArrMap\<rparr> = (op_cf ?lara\<lparr>ArrMap\<rparr>)"
	by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
	-
	have seq: "vfsequence (op_ntcf \<epsilon>)" unfolding op_ntcf_def by auto
	have card: "vcard (op_ntcf \<epsilon>) = 5\<^sub>\<nat>"
	unfolding op_ntcf_def by (simp add: nat_omega_simps)
	have op_cf_NTCod: "op_cf (\<epsilon>\<lparr>NTCod\<rparr>) = cf_id (op_cat \<DD>)"
	- unfolding assms(9) cat_op_simps by simp
	-
	- from assms(2) have op_cf_NTDom:
	- "op_cf (\<epsilon>\<lparr>NTDom\<rparr>) = op_cf \<FF> \<circ>\<^sub>C\<^sub>F cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>)"
	- unfolding assms(8) cat_op_simps \<GG>_def
	- by (simp_all add: cat_op_simps cf_ra_of_la_def del: op_cf_cf_la_of_ra_op)
	- have "op_ntcf \<epsilon> :
	- cf_id (op_cat \<DD>) \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> \<circ>\<^sub>C\<^sub>F cf_la_of_ra F (op_cf \<FF>) (op_ntcf \<epsilon>) :
	- op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<DD>"
	- by
	+ unfolding \<epsilon>_components cat_op_simps by simp
	+ from assms(3) have op_cf_NTDom:
	+ "op_cf (\<epsilon>\<lparr>NTDom\<rparr>) = op_cf \<FF> \<circ>\<^sub>C\<^sub>F cf_la_of_ra F (op_cf \<FF>) (\<epsilon>\<lparr>NTMap\<rparr>)"
	+ unfolding \<epsilon>_components
	+ by
	(
	- auto intro: cf_la_of_ra_is_ntcf
	- [
	- where F=F and \<eta>=\<open>op_ntcf \<epsilon>\<close>,
	- OF is_functor.is_functor_op[OF assms(2)],
	- unfolded cat_op_simps,
	- OF assms(3),
	- simplified,
	- unfolded
	- lara_ObjMap_eq_op
	- lara_ArrMap_eq_op
	- cf_ra_of_la_def[symmetric],
	- OF assms(4)[unfolded \<GG>_def],
	- simplified,
	- OF cf_ra_of_la_commute_op[
	- OF assms(2,4,5)[unfolded \<GG>_def], simplified
	- ],
	- simplified,
	- OF seq card _ op_cf_NTDom _ _ assms(12),
	- unfolded assms(8-11,13) cat_op_simps
	+ simp
	+ add: cat_op_simps \<GG>_def cf_ra_of_la_def \<epsilon>_components(1)[symmetric]
	+ del: op_cf_cf_la_of_ra_op
	+ )
	+ note cf_la_of_ra_is_ntcf
	+ [
	+ where F=F and \<eta>\<^sub>m=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<close>,
	+ OF is_functor.is_functor_op[OF assms(3)],
	+ unfolded cat_op_simps,
	+ OF assms(4),
	+ unfolded \<epsilon>_components(1),
	+ folded op_cf_NTCod op_cf_NTDom[unfolded \<epsilon>_components(1)] \<epsilon>_components(1),
	+ folded op_ntcf_def[of \<epsilon>, unfolded \<epsilon>_components(4,5)],
	+ unfolded
	+ cat_op_simps
	+ lara_ObjMap_eq_op lara_ArrMap_eq_op cf_ra_of_la_def[symmetric],
	+ folded \<GG>_def,
	+ simplified,
	+ OF
	+ assms(5)
	+ cf_ra_of_la_commute_op[
	+ OF assms(3,5,6)[unfolded \<GG>_def], folded \<GG>_def
	]
	- )
	+ assms(7,8),
	+ unfolded \<epsilon>_components,
	+ simplified
	+ ]
	from is_ntcf.is_ntcf_op[OF this, unfolded cat_op_simps \<GG>_def[symmetric]] show
	"\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>".
	-
	qed

	lemma cf_ra_of_la_is_counit:
	- fixes F \<FF> \<epsilon>
	- defines "\<GG> \<equiv> cf_ra_of_la F \<FF> \<epsilon>"
	+ fixes F \<DD> \<FF> \<GG> \<epsilon>\<^sub>m \<epsilon>
	+ defines "\<GG> \<equiv> cf_ra_of_la F \<FF> \<epsilon>\<^sub>m"
	+ and "\<epsilon> \<equiv> [\<epsilon>\<^sub>m, \<FF> \<circ>\<^sub>C\<^sub>F \<GG>, cf_id \<DD>, \<DD>, \<DD>]\<^sub>\<circ>"
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow> F d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<And>d. d \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr> \<Longrightarrow>
	universal_arrow_fo \<FF> d (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>)"
	and "\<And>d d' h. h : d \<mapsto>\<^bsub>\<DD>\<^esub> d' \<Longrightarrow>
	\<epsilon>\<lparr>NTMap\<rparr>\<lparr>d'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<rparr> = h \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
	and "vfsequence \<epsilon>"
	- and "vcard \<epsilon> = 5\<^sub>\<nat>"
	- and "\<epsilon>\<lparr>NTDom\<rparr> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	- and "\<epsilon>\<lparr>NTCod\<rparr> = cf_id \<DD>"
	- and "\<epsilon>\<lparr>NTDGDom\<rparr> = \<DD>"
	- and "\<epsilon>\<lparr>NTDGCod\<rparr> = \<DD>"
	and "vsv (\<epsilon>\<lparr>NTMap\<rparr>)"
	and "\<D>\<^sub>\<circ> (\<epsilon>\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	proof-
	+ have \<epsilon>_components:
	+ "\<epsilon>\<lparr>NTMap\<rparr> = \<epsilon>\<^sub>m"
	+ "\<epsilon>\<lparr>NTDom\<rparr> = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	+ "\<epsilon>\<lparr>NTCod\<rparr> = cf_id \<DD>"
	+ "\<epsilon>\<lparr>NTDGDom\<rparr> = \<DD>"
	+ "\<epsilon>\<lparr>NTDGCod\<rparr> = \<DD>"
	+ unfolding \<epsilon>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+ note \<GG>_def = \<GG>_def[folded \<epsilon>_components(1)]
	note \<FF> = cf_ra_of_la_is_functor[
	- where F=F and \<epsilon>=\<epsilon>, OF assms(4-7)[unfolded \<GG>_def], simplified
	+ where F=F and \<epsilon>=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<close>, OF assms(5-8)[unfolded \<GG>_def], simplified
	]
	- note \<epsilon> = cf_ra_of_la_is_ntcf[OF assms(4-15)[unfolded \<GG>_def], simplified]
	+ note \<epsilon> = cf_ra_of_la_is_ntcf
	+ [
	+ where F=F and \<epsilon>\<^sub>m=\<open>\<epsilon>\<^sub>m\<close> and \<DD>=\<DD> and \<FF>=\<FF>,
	+ folded \<GG>_def[unfolded \<epsilon>_components(1)],
	+ folded \<epsilon>_def,
	+ OF assms(5-8) assms(10,11),
	+ simplified
	+ ]
	show "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	by
	(
	- intro
	- cf_adjunction_of_counit_is_cf_adjunction
	- [
	- OF assms(2,3,4) \<FF> \<epsilon> assms(6)[unfolded \<GG>_def],
	- simplified,
	- folded \<GG>_def
	- ]
	+ intro cf_adjunction_of_counit_is_cf_adjunction
	+ [
	+ OF assms(3-5) \<FF>,
	+ folded \<GG>_def,
	+ OF \<epsilon> assms(7)[folded \<GG>_def],
	+ simplified
	+ ]
	)+
	qed



	subsection\<open>Construction of an adjunction from the counit-unit equations\<close>


	text\<open>
	The subsection presents the construction of an adjunction given
	two natural transformations satisfying counit-unit equations.
	The content of this subsection follows the statement and the proof
	of Theorem 2-v in Chapter IV-1 in \cite{mac_lane_categories_2010}.
	\<close>

	lemma counit_unit_is_cf_adjunction:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) = ntcf_id \<GG>"
	and "(\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>) = ntcf_id \<FF>"
	shows "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	and "\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<epsilon>"
	proof-

	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(4))
	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<eta> by (rule assms(5))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<epsilon> by (rule assms(6))

	have \<GG>\<epsilon>x_\<eta>\<GG>x[cat_cs_simps]:
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	if "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" for x
	proof-
	from assms(7) have
	"((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>))\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	by simp
	from this assms(1-6) that show
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> =
	\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed
	have [cat_cs_simps]:
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<eta>\<lparr>NTMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) =
	\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	if "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>" for x f a
	using assms(1-6) that
	by (intro \<CC>.cat_assoc_helper)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	have [cat_cs_simps]:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	if "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for x
	proof-
	from assms(8) have
	"((\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>))\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	by simp
	from this assms(1-6) that show
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<DD>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed

	have ua_\<FF>x_\<eta>x: "universal_arrow_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>)"
	if "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for x
	proof(intro is_functor.universal_arrow_ofI)
	from assms(3) that show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(3-6) that show "\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	fix r' u' assume prems': "r' \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" "u' : x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	show "\<exists>!f'.
	f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> r' \<and>
	u' = umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof(intro ex1I conjI; (elim conjE)?)
	from assms(3-6) that prems' show
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>u'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> r'"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3-6) prems' have \<GG>\<FF>u':
	"(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>u'\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>u'\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	note [cat_cs_simps] =
	\<eta>.ntcf_Comp_commute[symmetric, OF prems'(2), unfolded \<GG>\<FF>u']
	from assms(3-6) that prems' show
	"u' =
	umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) r'\<lparr>ArrVal\<rparr>\<lparr>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>u'\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	fix f' assume prems'':
	"f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> r'"
	"u' = umap_of \<GG> x (\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	from prems''(2,1) assms(3-6) that have u'_def:
	"u' = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	from
	\<epsilon>.ntcf_Comp_commute[OF prems''(1)]
	assms(3-6)
	prems''(1)
	have [cat_cs_simps]:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<rparr> =
	f' \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have [cat_cs_simps]:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f) =
	(f' \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>) \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f"
	if "f : a \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr>\<rparr>" for f a
	using assms(1-6) prems''(1) prems' that
	by (intro \<DD>.cat_assoc_helper)
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)+
	from prems''(2,1) assms(3-6) that show
	"f' = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>u'\<rparr>"
	unfolding u'_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
	)
	qed
	qed (auto intro: cat_cs_intros)

	show aou: "cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (intro cf_adjunction_of_unit_is_cf_adjunction ua_\<FF>x_\<eta>x assms(1-5))
	from \<CC>.category_axioms \<DD>.category_axioms show
	"\<eta>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<eta>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cf_adjunction_of_unit_is_cf_adjunction assms(1-5) ua_\<FF>x_\<eta>x
	)

	interpret aou: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<open>cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>\<close>
	by (rule aou)

	show "\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) = \<epsilon>"
	proof(rule ntcf_eqI)
	show \<epsilon>_\<eta>: "\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>) :
	\<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (rule aou.cf_adjunction_counit_is_ntcf)
	from assms(1-6) \<epsilon>_\<eta> have dom_lhs:
	"\<D>\<^sub>\<circ> (\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms(1-6) \<epsilon>_\<eta> have dom_rhs: "\<D>\<^sub>\<circ> (\<epsilon>\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	with aou.is_cf_adjunction_axioms assms(1-6) show
	"\<epsilon>\<^sub>C (cf_adjunction_of_unit \<alpha> \<FF> \<GG> \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_intro:
	cat_arrow_cs_intros
	cat_op_intros
	cat_cs_intros
	cat_prod_cs_intros
	cs_simp:
	aou.cf_adj_umap_of_unit'[symmetric]
	cat_Set_the_inverse[symmetric]
	adj_cs_simps cat_cs_simps cat_op_simps
	)
	qed (auto simp: adj_cs_intros)
	qed (auto simp: assms)

	qed

	lemma counit_unit_cf_adjunction_of_counit_is_cf_adjunction:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F cf_id \<DD> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) = ntcf_id \<GG>"
	and "(\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>) = ntcf_id \<FF>"
	shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<eta>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<eta>"
	and "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	proof-

	interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(3))
	interpret \<GG>: is_functor \<alpha> \<DD> \<CC> \<GG> by (rule assms(4))
	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<eta> by (rule assms(5))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<epsilon> by (rule assms(6))

	have unit_op: "cf_adjunction_of_unit \<alpha> (op_cf \<GG>) (op_cf \<FF>) (op_ntcf \<epsilon>) :
	op_cf \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<DD> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by (rule counit_unit_is_cf_adjunction(1)[where \<epsilon>=\<open>op_ntcf \<eta>\<close>])
	(
	cs_concl
	cs_simp:
	cat_op_simps cat_cs_simps
	\<GG>.cf_ntcf_id_op_cf
	\<FF>.cf_ntcf_id_op_cf
	op_ntcf_ntcf_vcomp[symmetric]
	op_ntcf_ntcf_cf_comp[symmetric]
	op_ntcf_cf_ntcf_comp[symmetric]
	assms(7,8)
	cs_intro: cat_op_intros cat_cs_intros
	)+
	then show aou: "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	unfolding cf_adjunction_of_counit_def
	by
	(
	subst \<FF>.cf_op_cf_op_cf[symmetric],
	subst \<GG>.cf_op_cf_op_cf[symmetric],
	subst \<CC>.cat_op_cat_op_cat[symmetric],
	subst \<DD>.cat_op_cat_op_cat[symmetric],
	rule is_cf_adjunction_op
	)

	interpret aou: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<open>cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>\<close>
	by (rule aou)

	show "\<eta>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<eta>"
	unfolding cf_adjunction_of_counit_def
	by (slow)
	(
	cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_counit[symmetric],
	rule unit_op,
	cs_concl_step counit_unit_is_cf_adjunction(3)[where \<epsilon>=\<open>op_ntcf \<eta>\<close>],
	- insert \<CC>.category_op \<DD>.category_op
	+ insert \<CC>.category_op \<DD>.category_op,
	+ rule \<DD>.category_op, rule \<CC>.category_op
	)
	(
	cs_concl
	cs_simp:
	cat_op_simps cat_cs_simps
	\<GG>.cf_ntcf_id_op_cf
	\<FF>.cf_ntcf_id_op_cf
	op_ntcf_ntcf_vcomp[symmetric]
	op_ntcf_ntcf_cf_comp[symmetric]
	op_ntcf_cf_ntcf_comp[symmetric]
	assms(7,8)
	cs_intro: cat_op_intros cat_cs_intros
	)+

	show "\<epsilon>\<^sub>C (cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon>) = \<epsilon>"
	unfolding cf_adjunction_of_counit_def
	by
	(
	cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_unit[symmetric],
	rule unit_op,
	cs_concl_step counit_unit_is_cf_adjunction(2)[where \<epsilon>=\<open>op_ntcf \<eta>\<close>],
	- insert \<CC>.category_op \<DD>.category_op
	+ insert \<CC>.category_op \<DD>.category_op,
	+ rule \<DD>.category_op, rule \<CC>.category_op
	)
	(
	cs_concl
	cs_simp:
	cat_op_simps cat_cs_simps
	\<GG>.cf_ntcf_id_op_cf
	\<FF>.cf_ntcf_id_op_cf
	op_ntcf_ntcf_vcomp[symmetric]
	op_ntcf_ntcf_cf_comp[symmetric]
	op_ntcf_cf_ntcf_comp[symmetric]
	assms(7,8)
	cs_intro: cat_op_intros cat_cs_intros
	)+

	qed



	subsection\<open>Adjoints are unique up to isomorphism\<close>


	text\<open>
	The content of the following subsection is based predominantly on
	the statement and the proof of Corollary 1 in
	Chapter IV-1 in \cite{mac_lane_categories_2010}. However, similar
	results can also be found in section 4 in \cite{riehl_category_2016}
	and in subsection 2.1 in \cite{bodo_categories_1970}.
	\<close>


	subsubsection\<open>Definitions and elementary properties\<close>

	definition cf_adj_LR_iso :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi> =
	[
	(
	\<lambda>x\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f'.
	let
	\<eta> = \<eta>\<^sub>C \<Phi>;
	\<eta>' = \<eta>\<^sub>C \<Psi>;
	\<FF>x = \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>;
	\<FF>'x = \<FF>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>
	in
	f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x \<and>
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x (\<FF>x) (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) (\<FF>'x)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	),
	\<FF>,
	\<FF>',
	\<CC>,
	\<DD>
	]\<^sub>\<circ>"

	definition cf_adj_RL_iso :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi> =
	[
	(
	\<lambda>x\<in>\<^sub>\<circ>\<DD>\<lparr>Obj\<rparr>. THE f'.
	let
	\<epsilon> = \<epsilon>\<^sub>C \<Phi>;
	\<epsilon>' = \<epsilon>\<^sub>C \<Psi>;
	\<GG>x = \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>;
	\<GG>'x = \<GG>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>
	in
	f' : \<GG>'x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>x \<and>
	\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	),
	\<GG>',
	\<GG>,
	\<DD>,
	\<CC>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma cf_adj_LR_iso_components:
	shows "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTMap\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f'.
	let
	\<eta> = \<eta>\<^sub>C \<Phi>;
	\<eta>' = \<eta>\<^sub>C \<Psi>;
	\<FF>x = \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>;
	\<FF>'x = \<FF>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>
	in
	f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x \<and>
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	and [adj_cs_simps]: "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTDom\<rparr> = \<FF>"
	and [adj_cs_simps]: "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTCod\<rparr> = \<FF>'"
	and [adj_cs_simps]: "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTDGDom\<rparr> = \<CC>"
	and [adj_cs_simps]: "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTDGCod\<rparr> = \<DD>"
	unfolding cf_adj_LR_iso_def nt_field_simps
	by (simp_all add: nat_omega_simps) (slow)

	lemma cf_adj_RL_iso_components:
	shows "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTMap\<rparr> =
	(
	\<lambda>x\<in>\<^sub>\<circ>\<DD>\<lparr>Obj\<rparr>. THE f'.
	let
	\<epsilon> = \<epsilon>\<^sub>C \<Phi>;
	\<epsilon>' = \<epsilon>\<^sub>C \<Psi>;
	\<GG>x = \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>;
	\<GG>'x = \<GG>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>
	in
	f' : \<GG>'x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>x \<and>
	\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	and [adj_cs_simps]: "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTDom\<rparr> = \<GG>'"
	and [adj_cs_simps]: "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTCod\<rparr> = \<GG>"
	and [adj_cs_simps]: "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTDGDom\<rparr> = \<DD>"
	and [adj_cs_simps]: "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTDGCod\<rparr> = \<CC>"
	unfolding cf_adj_RL_iso_def nt_field_simps
	by (simp_all add: nat_omega_simps) (slow)


	subsubsection\<open>Natural transformation map\<close>

	lemma cf_adj_LR_iso_vsv[adj_cs_intros]:
	"vsv (cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTMap\<rparr>)"
	unfolding cf_adj_LR_iso_components by simp

	lemma cf_adj_RL_iso_vsv[adj_cs_intros]:
	"vsv (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTMap\<rparr>)"
	unfolding cf_adj_RL_iso_components by simp

	lemma cf_adj_LR_iso_vdomain[adj_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	unfolding cf_adj_LR_iso_components by simp

	lemma cf_adj_RL_iso_vdomain[adj_cs_simps]:
	"\<D>\<^sub>\<circ> (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	unfolding cf_adj_RL_iso_components by simp

	lemma cf_adj_LR_iso_app:
	fixes \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>
	assumes "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	defines "\<FF>x \<equiv> \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<FF>'x \<equiv> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<eta> \<equiv> \<eta>\<^sub>C \<Phi>"
	and "\<eta>' \<equiv> \<eta>\<^sub>C \<Psi>"
	shows "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	(
	THE f'.
	f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x \<and>
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	using assms(1) unfolding cf_adj_LR_iso_components assms(2-5) by simp meson

	lemma cf_adj_RL_iso_app:
	fixes \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>
	assumes "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	defines "\<GG>x \<equiv> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<GG>'x \<equiv> \<GG>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<epsilon> \<equiv> \<epsilon>\<^sub>C \<Phi>"
	and "\<epsilon>' \<equiv> \<epsilon>\<^sub>C \<Psi>"
	shows "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	(
	THE f'.
	f' : \<GG>'x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>x \<and>
	\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	)"
	using assms(1) unfolding cf_adj_RL_iso_components assms(2-5) Let_def by simp

	lemma cf_adj_LR_iso_app_unique:
	fixes \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<Psi> : \<FF>' \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "x \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	defines "\<FF>x \<equiv> \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<FF>'x \<equiv> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<eta> \<equiv> \<eta>\<^sub>C \<Phi>"
	and "\<eta>' \<equiv> \<eta>\<^sub>C \<Psi>"
	and "f \<equiv> cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	shows
	"\<exists>!f'.
	f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x \<and>
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	"f : \<FF>x \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<DD>\<^esub> \<FF>'x"
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF>' \<GG> \<Psi> by (rule assms(2))
	note \<FF>a_\<eta> =
	is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
	OF assms(1) assms(3), folded assms(4-8)
	]
	note \<FF>'a_\<eta> =
	is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
	OF assms(2) assms(3), folded assms(4-8)
	]
	from
	is_functor.cf_universal_arrow_of_unique[
	OF \<Phi>.RL.is_functor_axioms \<FF>a_\<eta> \<FF>'a_\<eta>, folded assms(4-8)
	]
	obtain f'
	where f': "f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x"
	and \<eta>'_def:
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and unique_f':
	"\<lbrakk>
	f'' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x;
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>
	\<rbrakk> \<Longrightarrow> f'' = f'"
	for f''
	by metis
	show unique_f': "\<exists>!f'.
	f' : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x \<and>
	\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	by
	(
	rule is_functor.cf_universal_arrow_of_unique[
	OF \<Phi>.RL.is_functor_axioms \<FF>a_\<eta> \<FF>'a_\<eta>, folded assms(4-8)
	]
	)
	from
	theD
	[
	OF unique_f' cf_adj_LR_iso_app[
	OF assms(3), of \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>, folded assms(4-8)
	]
	]
	have f: "f : \<FF>x \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'x"
	and \<eta>': "\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by simp_all
	show "\<eta>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_of \<GG> x \<FF>x (\<eta>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<FF>'x\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>" by (rule \<eta>')
	show "f : \<FF>x \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<DD>\<^esub> \<FF>'x"
	by
	(
	rule
	- is_functor.cf_universal_arrow_of_is_arr_isomorphism[
	+ is_functor.cf_universal_arrow_of_is_iso_arr[
	OF \<Phi>.RL.is_functor_axioms \<FF>a_\<eta> \<FF>'a_\<eta> f \<eta>'
	]
	)
	qed


	subsubsection\<open>Main results\<close>

	lemma cf_adj_LR_iso_is_iso_functor:
	\<comment>\<open>See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<Psi> : \<FF>' \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	- shows "\<exists>!\<theta>.
	- \<theta> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD> \<and>
	- \<eta>\<^sub>C \<Psi> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	+ shows "\<exists>!\<theta>. \<theta> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD> \<and> \<eta>\<^sub>C \<Psi> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	and "cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	- and "\<eta>\<^sub>C \<Psi> =
	- (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	+ and "\<eta>\<^sub>C \<Psi> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	proof-

	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF>' \<GG> \<Psi> by (rule assms(2))

	let ?\<eta> = \<open>\<eta>\<^sub>C \<Phi>\<close>
	let ?\<eta>' = \<open>\<eta>\<^sub>C \<Psi>\<close>
	let ?\<Phi>\<Psi> = \<open>cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>\<close>

	show \<FF>'\<Psi>: "?\<Phi>\<Psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof(intro is_iso_ntcfI is_ntcfI')

	show "vfsequence ?\<Phi>\<Psi>" unfolding cf_adj_LR_iso_def by auto
	show "vcard ?\<Phi>\<Psi> = 5\<^sub>\<nat>"
	unfolding cf_adj_LR_iso_def by (simp add: nat_omega_simps)
	show "?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	using cf_adj_LR_iso_app_unique(2)[OF assms that] by auto

	show "?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> ?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	proof-

	from that have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	note unique_a = cf_adj_LR_iso_app_unique[OF assms a]
	note unique_b = cf_adj_LR_iso_app_unique[OF assms b]

	from unique_a(2) have a_is_arr:
	"?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by auto
	from unique_b(2) have b_is_arr:
	"?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto

	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> ?\<eta>
	by (rule \<Phi>.cf_adjunction_unit_is_ntcf)
	interpret \<eta>': is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>'\<close> ?\<eta>'
	by (rule \<Psi>.cf_adjunction_unit_is_ntcf)

	from unique_a(3) a_is_arr a b have \<eta>'_a_def:
	"?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)
	from unique_b(3) b_is_arr a b have \<eta>'_b_def:
	"?\<eta>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)

	from that a b a_is_arr have
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	(\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps \<eta>'_a_def cs_intro: cat_cs_intros
	)
	also from \<eta>'.ntcf_Comp_commute[OF that, symmetric] that a b have
	"\<dots> = ?\<eta>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from that a b b_is_arr have
	"\<dots> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	(?\<eta>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps \<eta>'_b_def cs_intro: cat_cs_intros
	)
	also from that have
	"\<dots> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	unfolding \<eta>.ntcf_Comp_commute[OF that, symmetric]
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps \<eta>'_b_def cs_intro: cat_cs_intros
	)
	also from that b_is_arr have
	"\<dots> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	(\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	finally have [cat_cs_simps]:
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	(\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	by simp

	note unique_f_a = is_functor.universal_arrow_ofD
	[
	OF
	\<Phi>.RL.is_functor_axioms
	\<Phi>.cf_adjunction_unit_component_is_ua_of[OF a]
	]

	from that a b a_is_arr b_is_arr have \<GG>\<FF>f_\<eta>a:
	"\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	a \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	from b have \<FF>'b: "\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	from unique_f_a(3)[OF \<FF>'b \<GG>\<FF>f_\<eta>a] obtain f'
	where f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and \<eta>a: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	umap_of \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and unique_f':
	"\<lbrakk>
	f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>;
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	umap_of \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>
	\<rbrakk> \<Longrightarrow> f'' = f'"
	for f''
	by metis
	have "?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = f'"
	by (rule unique_f', insert a b a_is_arr b_is_arr that)
	(
	cs_concl cs_shallow
	cs_simp: \<eta>'_a_def cat_cs_simps cs_intro: cat_cs_intros
	)
	moreover have "\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> ?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = f'"
	by (rule unique_f', insert a b a_is_arr b_is_arr that)
	(
	cs_concl cs_shallow
	cs_simp: \<eta>'_a_def cat_cs_simps cs_intro: cat_cs_intros
	)
	ultimately show ?thesis by simp
	qed

	qed
	(
	auto
	intro: cat_cs_intros adj_cs_intros
	simp: adj_cs_simps cf_adj_LR_iso_app_unique(2)[OF assms]
	)

	interpret \<FF>'\<Psi>: is_iso_ntcf \<alpha> \<CC> \<DD> \<FF> \<FF>' \<open>?\<Phi>\<Psi>\<close> by (rule \<FF>'\<Psi>)

	show \<eta>'_def: "?\<eta>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<Phi>\<Psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	proof(rule ntcf_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (?\<eta>'\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
	have dom_rhs: "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<Phi>\<Psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)
	show "?\<eta>'\<lparr>NTMap\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<Phi>\<Psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	note unique_a = cf_adj_LR_iso_app_unique[OF assms prems]
	from unique_a(2) have a_is_arr:
	"?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by auto
	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> ?\<eta>
	by (rule \<Phi>.cf_adjunction_unit_is_ntcf)
	from unique_a(3) a_is_arr prems have \<eta>'_a_def:
	"?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)
	from prems a_is_arr show
	"?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<Phi>\<Psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: \<eta>'_a_def cat_cs_simps cs_intro: cat_cs_intros
	)
	qed (auto intro: cat_cs_intros adj_cs_intros)
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)+

	show "\<exists>!\<theta>. \<theta> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD> \<and> ?\<eta>' = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>"
	proof(intro ex1I conjI; (elim conjE)?)
	from \<FF>'\<Psi> show "?\<Phi>\<Psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" by auto
	show "?\<eta>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<Phi>\<Psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>" by (rule \<eta>'_def)
	fix \<theta> assume prems:
	"\<theta> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	"?\<eta>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>"
	interpret \<theta>: is_ntcf \<alpha> \<CC> \<DD> \<FF> \<FF>' \<theta> by (rule prems(1))
	from prems have \<eta>'_a:
	"?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<^sub>C \<Phi>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	for a
	by simp
	have \<eta>'a: "\<eta>\<^sub>C \<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<theta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	using \<eta>'_a[where a=a] that
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)
	show "\<theta> = ?\<Phi>\<Psi>"
	proof(rule ntcf_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (\<theta>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (?\<Phi>\<Psi>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "\<theta>\<lparr>NTMap\<rparr> = ?\<Phi>\<Psi>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems': "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	let ?uof = \<open>umap_of \<GG> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (?\<eta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)\<close>
	from cf_adj_LR_iso_app_unique[OF assms prems'] obtain f'
	where f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and \<eta>_def: "?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?uof\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and unique_f': "\<And>f''.
	\<lbrakk>
	f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>;
	?\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?uof\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>
	\<rbrakk> \<Longrightarrow> f'' = f'"
	by metis
	from prems' have \<theta>a: "\<theta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from \<eta>_def f' prems' have
	"\<eta>\<^sub>C \<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	)
	from prems' have "\<eta>\<^sub>C \<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?uof\<lparr>ArrVal\<rparr>\<lparr>\<theta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_cs_simps \<eta>'a[OF prems']
	cs_intro: adj_cs_intros cat_cs_intros
	)
	from unique_f'[OF \<theta>a this] have \<theta>a: "\<theta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = f'".
	from prems' have \<Psi>a:
	"?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from prems' have "\<eta>\<^sub>C \<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?uof\<lparr>ArrVal\<rparr>\<lparr>?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	+ by
	+ (
	+ cs_concl
	cs_simp: cf_adj_LR_iso_app_unique(3)[OF assms] cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	from unique_f'[OF \<Psi>a this] have \<FF>'\<Psi>_def: "?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = f'".
	show "\<theta>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?\<Phi>\<Psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" unfolding \<theta>a \<FF>'\<Psi>_def ..
	qed auto
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)+
	qed

	qed

	lemma op_ntcf_cf_adj_RL_iso[cat_op_simps]:
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<Psi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG>' : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	defines "op_\<DD> \<equiv> op_cat \<DD>"
	and "op_\<CC> \<equiv> op_cat \<CC>"
	and "op_\<FF> \<equiv> op_cf \<FF>"
	and "op_\<GG> \<equiv> op_cf \<GG>"
	and "op_\<Phi> \<equiv> op_cf_adj \<Phi>"
	and "op_\<GG>' \<equiv> op_cf \<GG>'"
	and "op_\<Psi> \<equiv> op_cf_adj \<Psi>"
	shows
	"op_ntcf (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>) =
	cf_adj_LR_iso op_\<DD> op_\<CC> op_\<FF> op_\<GG> op_\<Phi> op_\<GG>' op_\<Psi>"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG>' \<Psi> by (rule assms(2))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	by (rule \<Phi>.cf_adjunction_counit_is_ntcf)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_ntcf (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>)) = 5\<^sub>\<nat>"
	unfolding op_ntcf_def by (simp add: nat_omega_simps)
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 5\<^sub>\<nat>"
	then have "a \<in>\<^sub>\<circ> 5\<^sub>\<nat>" unfolding dom_lhs by simp
	then show
	"op_ntcf (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>)\<lparr>a\<rparr> =
	cf_adj_LR_iso op_\<DD> op_\<CC> op_\<FF> op_\<GG> op_\<Phi> op_\<GG>' op_\<Psi>\<lparr>a\<rparr>"
	by
	(
	elim_in_numeral,
	fold nt_field_simps,
	unfold
	cf_adj_LR_iso_components
	op_ntcf_components
	cf_adj_RL_iso_components
	Let_def
	\<Phi>.cf_adjunction_unit_NTMap_op
	\<Psi>.cf_adjunction_unit_NTMap_op
	assms(3-9)
	cat_op_simps
	)
	simp_all
	qed (auto simp: op_ntcf_def cf_adj_LR_iso_def nat_omega_simps)
	qed

	lemma op_ntcf_cf_adj_LR_iso[cat_op_simps]:
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<Psi> : \<FF>' \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	defines "op_\<DD> \<equiv> op_cat \<DD>"
	and "op_\<CC> \<equiv> op_cat \<CC>"
	and "op_\<FF> \<equiv> op_cf \<FF>"
	and "op_\<GG> \<equiv> op_cf \<GG>"
	and "op_\<Phi> \<equiv> op_cf_adj \<Phi>"
	and "op_\<FF>' \<equiv> op_cf \<FF>'"
	and "op_\<Psi> \<equiv> op_cf_adj \<Psi>"
	shows
	"op_ntcf (cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>) =
	cf_adj_RL_iso op_\<DD> op_\<CC> op_\<GG> op_\<FF> op_\<Phi> op_\<FF>' op_\<Psi>"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF>' \<GG> \<Psi> by (rule assms(2))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	by (rule \<Phi>.cf_adjunction_counit_is_ntcf)
	have dom_lhs: "\<D>\<^sub>\<circ> (op_ntcf (cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>)) = 5\<^sub>\<nat>"
	unfolding op_ntcf_def by (simp add: nat_omega_simps)
	show ?thesis
	proof(rule vsv_eqI, unfold dom_lhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 5\<^sub>\<nat>"
	then show
	"op_ntcf (cf_adj_LR_iso \<CC> \<DD> \<GG> \<FF> \<Phi> \<FF>' \<Psi>)\<lparr>a\<rparr> =
	cf_adj_RL_iso op_\<DD> op_\<CC> op_\<GG> op_\<FF> op_\<Phi> op_\<FF>' op_\<Psi>\<lparr>a\<rparr>"
	by
	(
	elim_in_numeral,
	use nothing in
	\<open>
	fold nt_field_simps,
	unfold
	cf_adj_LR_iso_components
	op_ntcf_components
	cf_adj_RL_iso_components
	Let_def
	\<Phi>.op_ntcf_cf_adjunction_unit[symmetric]
	\<Psi>.op_ntcf_cf_adjunction_unit[symmetric]
	assms(3-9)
	cat_op_simps
	\<close>
	)
	simp_all
	qed (auto simp: op_ntcf_def cf_adj_RL_iso_def nat_omega_simps)
	qed

	lemma cf_adj_RL_iso_app_unique:
	fixes \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<Psi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG>' : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	defines "\<GG>x \<equiv> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<GG>'x \<equiv> \<GG>'\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>"
	and "\<epsilon> \<equiv> \<epsilon>\<^sub>C \<Phi>"
	and "\<epsilon>' \<equiv> \<epsilon>\<^sub>C \<Psi>"
	and "f \<equiv> cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	shows
	"\<exists>!f'.
	f' : \<GG>'x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>x \<and>
	\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	"f : \<GG>'x \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<GG>x"
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG>' \<Psi> by (rule assms(2))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	by (rule \<Phi>.cf_adjunction_counit_is_ntcf)
	show
	"\<exists>!f'.
	f' : \<GG>'x \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>x \<and>
	\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	"f : \<GG>'x \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<GG>x"
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = umap_fo \<FF> x \<GG>x (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>x\<rparr>) \<GG>'x\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by
	(
	intro cf_adj_LR_iso_app_unique
	[
	OF \<Phi>.is_cf_adjunction_op \<Psi>.is_cf_adjunction_op,
	unfolded cat_op_simps,
	OF assms(3),
	unfolded \<Psi>.cf_adjunction_unit_NTMap_op,
	folded \<Phi>.op_ntcf_cf_adjunction_counit,
	folded op_ntcf_cf_adj_RL_iso[OF assms(1,2)],
	unfolded cat_op_simps,
	folded assms(4-8)
	]
	)+
	qed

	lemma cf_adj_RL_iso_is_iso_functor:
	\<comment>\<open>See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<Psi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG>' : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	shows "\<exists>!\<theta>.
	\<theta> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<and>
	\<epsilon>\<^sub>C \<Psi> = \<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>)"
	and "cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<epsilon>\<^sub>C \<Psi> =
	\<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>)"
	proof-
	interpret \<Phi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG> \<Phi> by (rule assms(1))
	interpret \<Psi>: is_cf_adjunction \<alpha> \<CC> \<DD> \<FF> \<GG>' \<Psi> by (rule assms(2))
	interpret \<epsilon>: is_ntcf \<alpha> \<DD> \<DD> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<DD>\<close> \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	by (rule \<Phi>.cf_adjunction_counit_is_ntcf)
	note cf_adj_LR_iso_is_iso_functor_op = cf_adj_LR_iso_is_iso_functor
	[
	OF \<Phi>.is_cf_adjunction_op \<Psi>.is_cf_adjunction_op,
	folded
	\<Phi>.op_ntcf_cf_adjunction_counit
	\<Psi>.op_ntcf_cf_adjunction_counit
	op_ntcf_cf_adj_RL_iso[OF assms]
	]
	from cf_adj_LR_iso_is_iso_functor_op(1) obtain \<theta>
	where \<theta>: "\<theta> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	and op_ntcf_\<epsilon>_def: "op_ntcf (\<epsilon>\<^sub>C \<Psi>) =
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (\<epsilon>\<^sub>C \<Phi>)"
	and unique_\<theta>':
	"\<lbrakk>
	\<theta>' : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : op_cat \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>;
	op_ntcf (\<epsilon>\<^sub>C \<Psi>) = op_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (\<epsilon>\<^sub>C \<Phi>)
	\<rbrakk> \<Longrightarrow> \<theta>' = \<theta>"
	for \<theta>'
	by metis
	interpret \<theta>: is_ntcf \<alpha> \<open>op_cat \<DD>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<GG>'\<close> \<theta>
	by (rule \<theta>)
	show "\<exists>!\<theta>. \<theta> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<and> \<epsilon>\<^sub>C \<Psi> = \<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>)"
	proof(intro ex1I conjI; (elim conjE)?)
	show op_\<theta>: "op_ntcf \<theta> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule \<theta>.is_ntcf_op[unfolded cat_op_simps])
	from op_ntcf_\<epsilon>_def have
	"op_ntcf (op_ntcf (\<epsilon>\<^sub>C \<Psi>)) =
	op_ntcf (op_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (\<epsilon>\<^sub>C \<Phi>))"
	by simp
	then show \<epsilon>_def: "\<epsilon>\<^sub>C \<Psi> = \<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<theta>)"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_op_simps
	cs_intro: adj_cs_intros cat_cs_intros cat_op_intros
	)
	fix \<theta>' assume prems:
	"\<theta>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	"\<epsilon>\<^sub>C \<Psi> = \<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<theta>')"
	interpret \<theta>': is_ntcf \<alpha> \<DD> \<CC> \<GG>' \<GG> \<theta>' by (rule prems(1))
	have "op_ntcf (\<epsilon>\<^sub>C \<Psi>) = op_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<theta>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (\<epsilon>\<^sub>C \<Phi>)"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	prems(2)
	op_ntcf_cf_ntcf_comp[symmetric]
	op_ntcf_ntcf_vcomp[symmetric]
	cs_intro: cat_cs_intros
	)
	from unique_\<theta>'[OF \<theta>'.is_ntcf_op this, symmetric] have
	"op_ntcf \<theta> = op_ntcf (op_ntcf \<theta>')"
	by simp
	then show "\<theta>' = op_ntcf \<theta>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cat_op_simps) simp
	qed
	from is_iso_ntcf.is_iso_ntcf_op[OF cf_adj_LR_iso_is_iso_functor_op(2)] show
	"cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_op_simps cs_intro: adj_cs_intros cat_op_intros
	)
	from cf_adj_LR_iso_is_iso_functor_op(3) have
	"op_ntcf (op_ntcf (\<epsilon>\<^sub>C \<Psi>)) =
	op_ntcf
	(
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	op_ntcf (\<epsilon>\<^sub>C \<Phi>)
	)"
	by simp
	from
	this
	cf_adj_LR_iso_is_iso_functor_op(2)[
	unfolded op_ntcf_cf_adj_RL_iso[OF assms]
	]
	show "\<epsilon>\<^sub>C \<Psi> = \<epsilon>\<^sub>C \<Phi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F cf_adj_RL_iso \<CC> \<DD> \<FF> \<GG> \<Phi> \<GG>' \<Psi>)"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_op_simps cat_op_simps
	cs_intro: ntcf_cs_intros adj_cs_intros cat_cs_intros cat_op_intros
	)
	qed



	subsection\<open>Further properties of the adjoint functors\<close>

	lemma (in is_cf_adjunction) cf_adj_exp_cf_cat:
	\<comment>\<open>See Proposition 4.4.6 in \cite{riehl_category_2016}.\<close>
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<JJ>"
	shows
	"cf_adjunction_of_unit
	\<beta>
	(exp_cf_cat \<alpha> \<FF> \<JJ>)
	(exp_cf_cat \<alpha> \<GG> \<JJ>)
	(exp_ntcf_cat \<alpha> (\<eta>\<^sub>C \<Phi>) \<JJ>) :
	exp_cf_cat \<alpha> \<FF> \<JJ> \<rightleftharpoons>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<GG> \<JJ> :
	cat_FUNCT \<alpha> \<JJ> \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<DD>"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(3))
	show ?thesis
	proof
	(
	rule counit_unit_is_cf_adjunction(1)[
	where \<epsilon> = \<open>exp_ntcf_cat \<alpha> (\<epsilon>\<^sub>C \<Phi>) \<JJ>\<close>
	]
	)
	from assms show "exp_ntcf_cat \<alpha> (\<eta>\<^sub>C \<Phi>) \<JJ> :
	cf_id (cat_FUNCT \<alpha> \<JJ> \<CC>) \<mapsto>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<GG> \<JJ> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<JJ> :
	cat_FUNCT \<alpha> \<JJ> \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_FUNCT_cs_simps
	exp_cf_cat_cf_id_cat[symmetric] exp_cf_cat_cf_comp[symmetric]
	cs_intro:
	cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
	)
	from assms show
	"exp_ntcf_cat \<alpha> (\<epsilon>\<^sub>C \<Phi>) \<JJ> :
	exp_cf_cat \<alpha> \<FF> \<JJ> \<circ>\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<GG> \<JJ> \<mapsto>\<^sub>C\<^sub>F cf_id (cat_FUNCT \<alpha> \<JJ> \<DD>) :
	cat_FUNCT \<alpha> \<JJ> \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<DD>"
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_FUNCT_cs_simps
	exp_cf_cat_cf_id_cat[symmetric]
	exp_cf_cat_cf_comp[symmetric]
	cs_intro:
	cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
	)
	note [symmetric, cat_cs_simps] =
	ntcf_id_exp_cf_cat
	exp_ntcf_cat_ntcf_vcomp
	exp_ntcf_cat_ntcf_cf_comp
	exp_ntcf_cat_cf_ntcf_comp
	from assms show
	"(exp_cf_cat \<alpha> \<GG> \<JJ> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> (\<epsilon>\<^sub>C \<Phi>) \<JJ>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(exp_ntcf_cat \<alpha> (\<eta>\<^sub>C \<Phi>) \<JJ> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<GG> \<JJ>) =
	ntcf_id (exp_cf_cat \<alpha> \<GG> \<JJ>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	from assms show
	"exp_ntcf_cat \<alpha> (\<epsilon>\<^sub>C \<Phi>) \<JJ> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cf_cat \<alpha> \<FF> \<JJ> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(exp_cf_cat \<alpha> \<FF> \<JJ> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_ntcf_cat \<alpha> (\<eta>\<^sub>C \<Phi>) \<JJ>) =
	ntcf_id (exp_cf_cat \<alpha> \<FF> \<JJ>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	qed
	(
	use assms in
	\<open>
	cs_concl
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	\<close>
	)+
	qed

	lemma (in is_cf_adjunction) cf_adj_exp_cf_cat_exp_cf_cat:
	\<comment>\<open>See Proposition 4.4.6 in \cite{riehl_category_2016}.\<close>
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "category \<alpha> \<AA>"
	shows
	"cf_adjunction_of_unit
	\<beta>
	(exp_cat_cf \<alpha> \<AA> \<GG>)
	(exp_cat_cf \<alpha> \<AA> \<FF>)
	(exp_cat_ntcf \<alpha> \<AA> (\<eta>\<^sub>C \<Phi>)) :
	exp_cat_cf \<alpha> \<AA> \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<AA>"
	proof-

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<AA>: category \<alpha> \<AA> by (rule assms(3))

	show ?thesis
	proof
	(
	rule counit_unit_is_cf_adjunction(1)[
	where \<epsilon> = \<open>exp_cat_ntcf \<alpha> \<AA> (\<epsilon>\<^sub>C \<Phi>)\<close>
	]
	)
	from assms is_cf_adjunction_axioms show
	"exp_cat_ntcf \<alpha> \<AA> (\<eta>\<^sub>C \<Phi>) :
	cf_id (cat_FUNCT \<alpha> \<CC> \<AA>) \<mapsto>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG> :
	cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<CC> \<AA>"
	by
	(
	cs_concl
	cs_simp:
	exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
	cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
	)
	from assms is_cf_adjunction_axioms show
	"exp_cat_ntcf \<alpha> \<AA> (\<epsilon>\<^sub>C \<Phi>) :
	exp_cat_cf \<alpha> \<AA> \<GG> \<circ>\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF> \<mapsto>\<^sub>C\<^sub>F cf_id (cat_FUNCT \<alpha> \<DD> \<AA>) :
	cat_FUNCT \<alpha> \<DD> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<DD> \<AA>"
	by
	(
	cs_concl
	cs_simp:
	exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
	cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
	)
	note [symmetric, cat_cs_simps] =
	ntcf_id_exp_cat_cf
	exp_cat_ntcf_ntcf_vcomp
	exp_cat_ntcf_ntcf_cf_comp
	exp_cat_ntcf_cf_ntcf_comp
	from assms show
	"exp_cat_cf \<alpha> \<AA> \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> (\<epsilon>\<^sub>C \<Phi>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(exp_cat_ntcf \<alpha> \<AA> (\<eta>\<^sub>C \<Phi>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<FF>) =
	ntcf_id (exp_cat_cf \<alpha> \<AA> \<FF>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	from assms show
	"exp_cat_ntcf \<alpha> \<AA> (\<epsilon>\<^sub>C \<Phi>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F exp_cat_cf \<alpha> \<AA> \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(exp_cat_cf \<alpha> \<AA> \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F exp_cat_ntcf \<alpha> \<AA> (\<eta>\<^sub>C \<Phi>)) =
	- ntcf_id (exp_cat_cf \<alpha> \<AA> \<GG>)"
	+ ntcf_id (exp_cat_cf \<alpha> \<AA> \<GG>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: adj_cs_simps cat_cs_simps
	cs_intro: adj_cs_intros cat_cs_intros
	)
	qed
	(
	use assms in
	\<open>
	cs_concl
	cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
	\<close>
	)+

	qed

	+
	+
	+subsection\<open>Adjoints on limits\<close>
	+
	+lemma cf_AdjRight_preserves_limits:
	+ \<comment>\<open>See Chapter V-5 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<Phi> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<XX> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ shows "is_cf_continuous \<alpha> \<GG>"
	+proof(intro is_cf_continuousI)
	+
	+ interpret \<Phi>: is_cf_adjunction \<alpha> \<XX> \<AA> \<FF> \<GG> \<Phi> by (rule assms(1))
	+
	+ show "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>" by (rule \<Phi>.RL.is_functor_axioms)
	+
	+ fix \<TT> \<JJ> assume prems: "\<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+
	+ show "cf_preserves_limits \<alpha> \<GG> \<TT>"
	+ proof(intro cf_preserves_limitsI, rule prems, rule \<Phi>.RL.is_functor_axioms)
	+
	+ fix \<tau> a assume "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<tau>: is_cat_limit \<alpha> \<JJ> \<AA> \<TT> a \<tau> .
	+
	+ show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ proof(intro is_cat_limitI)
	+
	+ show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> \<circ>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ by
	+ (
	+ intro cf_ntcf_comp_cf_cat_cone prems,
	+ rule \<tau>.is_cat_cone_axioms,
	+ intro \<Phi>.RL.is_functor_axioms
	+ )
	+
	+ fix \<sigma>' b' assume "\<sigma>' : b' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> \<circ>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ then interpret \<sigma>': is_cat_cone \<alpha> b' \<JJ> \<XX> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<TT>\<close> \<sigma>' .
	+
	+ have "\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> : \<FF> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<TT>) \<mapsto>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
	+ moreover have "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>' :
	+ \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<TT>) : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by
	+ (
	+ intro cf_ntcf_comp_cf_cat_cone,
	+ rule \<sigma>'.is_cat_cone_axioms,
	+ rule \<Phi>.LR.is_functor_axioms
	+ )
	+ ultimately have "(\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>') :
	+ \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by (rule ntcf_vcomp_is_cat_cone)
	+ from \<tau>.cat_lim_unique_cone'[OF this] obtain h
	+ where h: "h : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a"
	+ and \<epsilon>\<TT>_\<FF>\<sigma>': "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ ((\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'))\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h"
	+ and h_unique:
	+ "\<lbrakk>
	+ h' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ ((\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'))\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h'
	+ \<rbrakk> \<Longrightarrow> h' = h"
	+ for h'
	+ by metis
	+ have \<epsilon>\<TT>_\<FF>\<sigma>:
	+ "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>\<TT>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr> =
	+ \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using \<epsilon>\<TT>_\<FF>\<sigma>'[OF that] that
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
	+ )
	+
	+ show "\<exists>!f'.
	+ f' : b' \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<and> \<sigma>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ let ?h' = \<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
	+ from h show "?h' : b' \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: cat_cs_intros cat_lim_cs_intros adj_cs_intros
	+ )
	+ show "\<sigma>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> ?h'"
	+ proof(rule ntcf_eqI)
	+ show "\<sigma>' : cf_const \<JJ> \<XX> b' \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ by (rule \<sigma>'.is_ntcf_axioms)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>'\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from h show
	+ "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> ?h' :
	+ cf_const \<JJ> \<XX> b' \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<TT> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_lim_cs_intros adj_cs_intros cat_cs_intros
	+ )
	+ then have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> ?h')\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "\<sigma>'\<lparr>NTMap\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> ?h')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix j assume prems': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ note [cat_cs_simps] = \<Phi>.L.cat_assoc_helper
	+ [
	+ where h=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr>\<close>
	+ and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close>
	+ and f=\<open>\<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
	+ and q=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h\<rparr>\<close>
	+ ]
	+ from prems' h have [cat_cs_simps]:
	+ "\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = \<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps \<epsilon>\<TT>_\<FF>\<sigma>[OF prems', symmetric]
	+ cs_intro: adj_cs_intros cat_cs_intros
	+ )
	+ from prems' h show
	+ "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> ?h')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_lim_cs_intros adj_cs_intros cat_cs_intros
	+ )
	+ qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
	+ qed simp_all
	+
	+ fix f' assume prems':
	+ "f' : b' \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ "\<sigma>' = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> f'"
	+
	+ from prems'(2) have \<sigma>'_j_def':
	+ "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<XX> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ for j
	+ by simp
	+ have \<sigma>'_j_def: "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f'"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using \<sigma>'_j_def'[of j] that prems'(1)
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
	+ )
	+
	+ from prems'(1) have \<epsilon>a_\<FF>f':
	+ "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a"
	+ by (cs_concl cs_intro: cat_lim_cs_intros cat_cs_intros adj_cs_intros)
	+
	+ interpret \<epsilon>: is_ntcf \<alpha> \<AA> \<AA> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<open>cf_id \<AA>\<close> \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	+ by (rule \<Phi>.cf_adjunction_counit_is_ntcf)
	+
	+ have
	+ "(\<epsilon>\<^sub>C \<Phi> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'))\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> (\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>)"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ proof-
	+ from that have "\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ from \<epsilon>.ntcf_Comp_commute[OF this] that have [cat_cs_simps]:
	+ "\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>\<TT>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr>\<rparr> =
	+ \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ note [cat_cs_simps] = \<Phi>.R.cat_assoc_helper
	+ [
	+ where h=\<open>\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>\<TT>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>\<rparr>\<close>
	+ and g=\<open>\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr>\<rparr>\<close>
	+ and q=\<open>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<close>
	+ ]
	+ show ?thesis
	+ using that prems'(1)
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps \<sigma>'_j_def
	+ cs_intro: cat_lim_cs_intros cat_cs_intros adj_cs_intros
	+ )
	+ qed
	+ from h_unique[OF \<epsilon>a_\<FF>f' this] have
	+ "\<GG>\<lparr>ArrMap\<rparr>\<lparr>\<epsilon>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = ?h'"
	+ by simp
	+ from this prems'(1) show "f' = \<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> \<eta>\<^sub>C \<Phi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps \<Phi>.cf_adj_counit_unit_app
	+ cs_intro: cat_lim_cs_intros cat_cs_intros
	+ )
	+ qed
	+
	+ qed
	+
	+ qed
	+
	+qed
	+
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Comma.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Comma.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Comma.thy
	@@ -0,0 +1,882 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Comma categories and universal constructions\<close>
	+theory CZH_UCAT_Comma
	+ imports CZH_UCAT_Limit_IT
	+begin
	+
	+
	+
	+subsection\<open>
	+Relationship between the universal arrows, initial objects and terminal objects
	+\<close>
	+
	+lemma (in is_functor) universal_arrow_of_if_obj_initial:
	+ \<comment>\<open>See Chapter III-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "obj_initial (c \<down>\<^sub>C\<^sub>F \<FF>) [0, r, u]\<^sub>\<circ>"
	+ shows "universal_arrow_of \<FF> c r u"
	+proof(intro universal_arrow_ofI)
	+ have ru: "[0, r, u]\<^sub>\<circ> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	+ and f_unique: "C \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>!f. f : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C"
	+ for C
	+ by (intro obj_initialD[OF assms(2)])+
	+ show r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and u: "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by (intro cat_obj_cf_comma_ObjD[OF ru assms(1)])+
	+ fix r' u' assume prems: "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+ from assms(1) prems have r'u': "[0, r', u']\<^sub>\<circ> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	+ from f_unique[OF r'u'] obtain F
	+ where F: "F : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [0, r', u']\<^sub>\<circ>"
	+ and F_unique: "F' : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [0, r', u']\<^sub>\<circ> \<Longrightarrow> F' = F"
	+ for F'
	+ by metis
	+ from cat_obj_cf_comma_is_arrE[OF F assms(1), simplified] obtain t
	+ where F_def: "F = [[0, r, u]\<^sub>\<circ>, [0, r', u']\<^sub>\<circ>, [0, t]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and t: "t : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	+ and [cat_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>t\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u = u'"
	+ by metis
	+ show "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ proof(intro ex1I conjI; (elim conjE)?; (rule t)?)
	+ from t u show "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>t\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ fix t' assume prems': "t' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'" "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>t'\<rparr>"
	+ from prems'(2,1) u have [symmetric, cat_cs_simps]:
	+ "u' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>t'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ define F' where "F' = [[0, r, u]\<^sub>\<circ>, [0, r', u']\<^sub>\<circ>, [0, t']\<^sub>\<circ>]\<^sub>\<circ>"
	+ from assms(1) prems'(1) u prems(2) have F':
	+ "F' : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [0, r', u']\<^sub>\<circ>"
	+ unfolding F'_def
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros)
	+ from F_unique[OF this] show "t' = t" unfolding F'_def F_def by simp
	+ qed
	+qed
	+
	+lemma (in is_functor) obj_initial_if_universal_arrow_of:
	+ \<comment>\<open>See Chapter III-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "universal_arrow_of \<FF> c r u"
	+ shows "obj_initial (c \<down>\<^sub>C\<^sub>F \<FF>) [0, r, u]\<^sub>\<circ>"
	+proof-
	+ from universal_arrow_ofD[OF assms] have r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and u: "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ and up: "\<lbrakk> r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<rbrakk> \<Longrightarrow>
	+ \<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ for r' u'
	+ by auto
	+ from u have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	+ show ?thesis
	+ proof(intro obj_initialI)
	+ from r u show "[0, r, u]\<^sub>\<circ> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	+ fix B assume prems: "B \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
	+ from cat_obj_cf_comma_ObjE[OF prems c] obtain r' u'
	+ where B_def: "B = [0, r', u']\<^sub>\<circ>"
	+ and r': "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and u': "u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+ by auto
	+ from up[OF r' u'] obtain f
	+ where f: "f : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	+ and u'_def: "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ and up': "\<lbrakk> f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'; u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> \<rbrakk> \<Longrightarrow>
	+ f' = f"
	+ for f'
	+ by auto
	+ from u'_def f u have [symmetric, cat_cs_simps]: "u' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ define F where "F = [[0, r, u]\<^sub>\<circ>, [0, r', u']\<^sub>\<circ>, [0, f]\<^sub>\<circ>]\<^sub>\<circ>"
	+ show "\<exists>!f. f : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
	+ unfolding B_def
	+ proof(rule ex1I)
	+ from c u f u' show "F : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [0, r', u']\<^sub>\<circ>"
	+ unfolding F_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros
	+ )
	+ fix F' assume prems': "F' : [0, r, u]\<^sub>\<circ> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [0, r', u']\<^sub>\<circ>"
	+ from cat_obj_cf_comma_is_arrE[OF prems' c, simplified] obtain f'
	+ where F'_def: "F' = [[0, r, u]\<^sub>\<circ>, [0, r', u']\<^sub>\<circ>, [0, f']\<^sub>\<circ>]\<^sub>\<circ>"
	+ and f': "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	+ and [cat_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u = u'"
	+ by auto
	+ from f' u have "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from up'[OF f' this] show "F' = F" unfolding F'_def F_def by simp
	+ qed
	+ qed
	+qed
	+
	+lemma (in is_functor) universal_arrow_fo_if_obj_terminal:
	+ \<comment>\<open>See Chapter III-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "obj_terminal (\<FF> \<^sub>C\<^sub>F\<down> c) [r, 0, u]\<^sub>\<circ>"
	+ shows "universal_arrow_fo \<FF> c r u"
	+proof-
	+ let ?op_\<FF>c = \<open>op_cat (\<FF> \<^sub>C\<^sub>F\<down> c)\<close>
	+ and ?c_op_\<FF> = \<open>c \<down>\<^sub>C\<^sub>F (op_cf \<FF>)\<close>
	+ and ?iso = \<open>op_cf_obj_comma \<FF> c\<close>
	+ from cat_cf_obj_comma_ObjD[OF obj_terminalD(1)[OF assms(2)] assms(1)]
	+ have r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and u: "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	+ by simp_all
	+ interpret \<FF>c: is_iso_functor \<alpha> ?op_\<FF>c ?c_op_\<FF> ?iso
	+ by (rule op_cf_obj_comma_is_iso_functor[OF assms(1)])
	+ have iso_cocontinuous: "is_cf_cocontinuous \<alpha> ?iso"
	+ by
	+ (
	+ rule is_iso_functor.iso_cf_is_cf_cocontinuous[
	+ OF \<FF>c.is_iso_functor_axioms
	+ ]
	+ )
	+ have iso_preserves: "cf_preserves_colimits \<alpha> ?iso (cf_0 ?op_\<FF>c)"
	+ by
	+ (
	+ rule is_cf_cocontinuousD
	+ [
	+ OF
	+ iso_cocontinuous
	+ cf_0_is_functor[OF \<FF>c.HomDom.category_axioms]
	+ \<FF>c.is_functor_axioms
	+ ]
	+ )
	+ from category.cat_obj_initial_is_cat_obj_empty_initial[
	+ OF \<FF>c.HomDom.category_axioms op_cat_obj_initial[THEN iffD2, OF assms(2)]
	+ ]
	+ interpret ntcf_0_op_\<FF>c:
	+ is_cat_obj_empty_initial \<alpha> ?op_\<FF>c \<open>[r, 0, u]\<^sub>\<circ>\<close> \<open>ntcf_0 ?op_\<FF>c\<close>
	+ by simp
	+ have "cf_0 ?op_\<FF>c : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?op_\<FF>c"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from
	+ cf_preserves_colimitsD
	+ [
	+ OF
	+ iso_preserves
	+ ntcf_0_op_\<FF>c.is_cat_colimit_axioms
	+ this
	+ \<FF>c.is_functor_axioms
	+ ]
	+ assms(1) r u
	+ have "ntcf_0 ?c_op_\<FF> :
	+ cf_0 ?c_op_\<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m [0, r, u]\<^sub>\<circ> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?c_op_\<FF>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cat_comma_cs_simps
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ then have obj_initial_ru: "obj_initial ?c_op_\<FF> [0, r, u]\<^sub>\<circ>"
	+ by
	+ (
	+ rule is_cat_obj_empty_initial.cat_oei_obj_initial[
	+ OF is_cat_obj_empty_initialI
	+ ]
	+ )
	+ from assms(1) have "c \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_op_intros)
	+ from
	+ is_functor.universal_arrow_of_if_obj_initial[
	+ OF is_functor_op this obj_initial_ru
	+ ]
	+ have "universal_arrow_of (op_cf \<FF>) c r u"
	+ by simp
	+ then show ?thesis unfolding cat_op_simps .
	+qed
	+
	+lemma (in is_functor) obj_terminal_if_universal_arrow_fo:
	+ \<comment>\<open>See Chapter III-1 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "universal_arrow_fo \<FF> c r u"
	+ shows "obj_terminal (\<FF> \<^sub>C\<^sub>F\<down> c) [r, 0, u]\<^sub>\<circ>"
	+proof-
	+ let ?op_\<FF>c = \<open>op_cat (\<FF> \<^sub>C\<^sub>F\<down> c)\<close>
	+ and ?c_op_\<FF> = \<open>c \<down>\<^sub>C\<^sub>F (op_cf \<FF>)\<close>
	+ and ?iso = \<open>inv_cf (op_cf_obj_comma \<FF> c)\<close>
	+ from universal_arrow_foD[OF assms] have r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and u: "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	+ by auto
	+ then have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	+ from u have c_op_\<FF>: "category \<alpha> ?c_op_\<FF>"
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_cs_intros cat_comma_cs_intros cat_op_intros
	+ )
	+ interpret \<FF>c: is_iso_functor \<alpha> ?op_\<FF>c ?c_op_\<FF> \<open>op_cf_obj_comma \<FF> c\<close>
	+ by (rule op_cf_obj_comma_is_iso_functor[OF c])
	+ interpret inv_\<FF>c: is_iso_functor \<alpha> ?c_op_\<FF> ?op_\<FF>c ?iso
	+ by (cs_concl cs_shallow cs_intro: cf_cs_intros)
	+ have iso_cocontinuous: "is_cf_cocontinuous \<alpha> ?iso"
	+ by
	+ (
	+ rule is_iso_functor.iso_cf_is_cf_cocontinuous[
	+ OF inv_\<FF>c.is_iso_functor_axioms
	+ ]
	+ )
	+ have iso_preserves: "cf_preserves_colimits \<alpha> ?iso (cf_0 ?c_op_\<FF>)"
	+ by
	+ (
	+ rule is_cf_cocontinuousD
	+ [
	+ OF
	+ iso_cocontinuous
	+ cf_0_is_functor[OF \<FF>c.HomCod.category_axioms]
	+ inv_\<FF>c.is_functor_axioms
	+ ]
	+ )
	+ from assms have "universal_arrow_of (op_cf \<FF>) c r u" unfolding cat_op_simps.
	+ from is_cat_obj_empty_initialD
	+ [
	+ OF category.cat_obj_initial_is_cat_obj_empty_initial
	+ [
	+ OF c_op_\<FF> is_functor.obj_initial_if_universal_arrow_of[
	+ OF is_functor_op this
	+ ]
	+ ]
	+ ]
	+ have ntcf_0_c_op_\<FF>: "ntcf_0 ?c_op_\<FF> :
	+ cf_0 ?c_op_\<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m [0, r, u]\<^sub>\<circ> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?c_op_\<FF>".
	+ have cf_0_c_op_\<FF>: "cf_0 ?c_op_\<FF> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?c_op_\<FF>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from
	+ cf_preserves_colimitsD[
	+ OF iso_preserves ntcf_0_c_op_\<FF> cf_0_c_op_\<FF> inv_\<FF>c.is_functor_axioms
	+ ]
	+ r u
	+ have "ntcf_0 ?op_\<FF>c : cf_0 ?op_\<FF>c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m [r, 0, u]\<^sub>\<circ> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> ?op_\<FF>c"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cat_comma_cs_simps \<FF>c.inv_cf_ObjMap_app
	+ cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	+ )
	+ from
	+ is_cat_obj_empty_initial.cat_oei_obj_initial[
	+ OF is_cat_obj_empty_initialI[OF this]
	+ ]
	+ show "obj_terminal (\<FF> \<^sub>C\<^sub>F\<down> c) [r, 0, u]\<^sub>\<circ>"
	+ unfolding op_cat_obj_initial[symmetric].
	+qed
	+
	+
	+
	+subsection\<open>
	+A projection for a comma category constructed from a functor and an object
	+creates small limits
	+\<close>
	+
	+text\<open>See Chapter V-6 in \cite{mac_lane_categories_2010}.\<close>
	+
	+lemma cf_obj_cf_comma_proj_creates_limits:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ and "is_tm_cf_continuous \<alpha> \<GG>"
	+ and "x \<in>\<^sub>\<circ> \<XX>\<lparr>Obj\<rparr>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ shows "cf_creates_limits \<alpha> (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>) \<FF>"
	+proof(intro cf_creates_limitsI conjI allI impI)
	+
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<XX> \<GG> by (rule assms(1))
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<FF> by (rule assms(4))
	+ interpret x\<GG>: is_functor \<alpha> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<AA> \<open>x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<close>
	+ by (rule \<GG>.cf_obj_cf_comma_proj_is_functor[OF assms(3)])
	+
	+ show "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>" by (rule \<FF>.is_functor_axioms)
	+ show "x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> : x \<down>\<^sub>C\<^sub>F \<GG> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" by (rule x\<GG>.is_functor_axioms)
	+
	+ define \<psi> :: V
	+ where "\<psi> =
	+ [
	+ (\<lambda>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>),
	+ cf_const \<JJ> \<XX> x,
	+ \<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>),
	+ \<JJ>,
	+ \<XX>
	+ ]\<^sub>\<circ>"
	+
	+ have \<psi>_components:
	+ "\<psi>\<lparr>NTMap\<rparr> = (\<lambda>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>)"
	+ "\<psi>\<lparr>NTDom\<rparr> = cf_const \<JJ> \<XX> x"
	+ "\<psi>\<lparr>NTCod\<rparr> = \<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
	+ "\<psi>\<lparr>NTDGDom\<rparr> = \<JJ>"
	+ "\<psi>\<lparr>NTDGCod\<rparr> = \<XX>"
	+ unfolding \<psi>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+
	+ have \<psi>_NTMap_app: "\<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [a, b, f]\<^sub>\<circ>" for a b f j
	+ using that unfolding \<psi>_components by (simp add: nat_omega_simps)
	+
	+ interpret \<psi>: is_cat_cone \<alpha> x \<JJ> \<XX> \<open>\<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<close> \<psi>
	+ proof(intro is_cat_coneI is_ntcfI')
	+ show "vfsequence \<psi>" unfolding \<psi>_def by clarsimp
	+ show "vcard \<psi> = 5\<^sub>\<nat>" unfolding \<psi>_def by (simp add: nat_omega_simps)
	+ show "\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_const \<JJ> \<XX> x\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<XX>\<^esub> (\<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>))\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a
	+ proof-
	+ from that have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> x \<down>\<^sub>C\<^sub>F \<GG>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF this assms(3)] obtain c g
	+ where \<FF>a_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = [0, c, g]\<^sub>\<circ>"
	+ and c: "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g: "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by auto
	+ from c g show ?thesis
	+ using that
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_comma_cs_simps cat_cs_simps \<FF>a_def \<psi>_NTMap_app
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ qed
	+ show
	+ "\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> cf_const \<JJ> \<XX> x\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	+ (\<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>))\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> \<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for a b f
	+ proof-
	+ from that have \<FF>f: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this assms(3)] obtain c h c' h' k
	+ where \<FF>f_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = [[0, c, h]\<^sub>\<circ>, [0, c', h']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>a_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = [0, c, h]\<^sub>\<circ>"
	+ and \<FF>b_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = [0, c', h']\<^sub>\<circ>"
	+ and k: "k : c \<mapsto>\<^bsub>\<AA>\<^esub> c'"
	+ and h: "h : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and h': "h' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> h = h'"
	+ by metis
	+ from \<FF>f k h h' that show ?thesis
	+ unfolding \<FF>f_def \<FF>a_def \<FF>b_def
	+ by (slow)
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps cat_comma_cs_simps
	+ \<FF>f_def \<FF>a_def \<FF>b_def \<psi>_NTMap_app
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+ qed (auto simp: assms(3) \<psi>_components intro: cat_cs_intros)
	+
	+ fix \<tau> b assume prems: "\<tau> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ interpret \<tau>: is_cat_limit \<alpha> \<JJ> \<AA> \<open>x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> b \<tau> by (rule prems)
	+
	+ note x\<GG>_\<FF> = cf_comp_cf_obj_cf_comma_proj_is_tm_functor[OF assms(1,4,3)]
	+ have "cf_preserves_limits \<alpha> \<GG> (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
	+ by (rule is_tm_cf_continuousD [OF assms(2) x\<GG>_\<FF> assms(1)])
	+ then have \<GG>\<tau>: "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> :
	+ \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<XX>"
	+ by
	+ (
	+ rule cf_preserves_limitsD[
	+ OF _ prems(1) is_tm_functorD(1)[OF x\<GG>_\<FF>] assms(1)
	+ ]
	+ )
	+
	+ from is_cat_limit.cat_lim_unique_cone'[OF \<GG>\<tau> \<psi>.is_cat_cone_axioms] obtain f
	+ where f: "f : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+ and \<psi>_f: "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ \<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f"
	+ and f_unique:
	+ "\<lbrakk>
	+ f' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f'
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+
	+ define \<sigma> :: V
	+ where "\<sigma> =
	+ [
	+ (
	+ \<lambda>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>.
	+ [
	+ [0, b, f]\<^sub>\<circ>,
	+ [0, (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>, \<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>,
	+ [0, \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>
	+ ]\<^sub>\<circ>
	+ ),
	+ cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ>,
	+ \<FF>,
	+ \<JJ>,
	+ x \<down>\<^sub>C\<^sub>F \<GG>
	+ ]\<^sub>\<circ>"
	+
	+ have \<sigma>_components: "\<sigma>\<lparr>NTMap\<rparr> =
	+ (
	+ \<lambda>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>.
	+ [
	+ [0, b, f]\<^sub>\<circ>,
	+ [0, (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>, \<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>,
	+ [0, \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>
	+ ]\<^sub>\<circ>
	+ )"
	+ and [cat_cs_simps]: "\<sigma>\<lparr>NTDom\<rparr> = cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ>"
	+ and [cat_cs_simps]: "\<sigma>\<lparr>NTCod\<rparr> = \<FF>"
	+ and [cat_cs_simps]: "\<sigma>\<lparr>NTDGDom\<rparr> = \<JJ>"
	+ and [cat_cs_simps]: "\<sigma>\<lparr>NTDGCod\<rparr> = x \<down>\<^sub>C\<^sub>F \<GG>"
	+ unfolding \<sigma>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+
	+ have \<sigma>_NTMap_app: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ [
	+ [0, b, f]\<^sub>\<circ>,
	+ [0, (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>, \<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>,
	+ [0, \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>]\<^sub>\<circ>
	+ ]\<^sub>\<circ>"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using that unfolding \<sigma>_components by simp
	+
	+ interpret \<sigma>: is_cat_cone \<alpha> \<open>[0, b, f]\<^sub>\<circ>\<close> \<JJ> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<FF> \<sigma>
	+ proof(intro is_cat_coneI is_ntcfI')
	+ show "vfsequence \<sigma>" unfolding \<sigma>_def by auto
	+ show "vcard \<sigma> = 5\<^sub>\<nat>" unfolding \<sigma>_def by (simp add: nat_omega_simps)
	+ from f show "cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by
	+ (
	+ cs_concl cs_intro:
	+ cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	+ )
	+ show "vsv (\<sigma>\<lparr>NTMap\<rparr>)" unfolding \<sigma>_components by auto
	+ show "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>" unfolding \<sigma>_components by auto
	+ from assms(3) show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a
	+ proof-
	+ from that have \<FF>a: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> x \<down>\<^sub>C\<^sub>F \<GG>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF this assms(3)] obtain c g
	+ where \<FF>a_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = [0, c, g]\<^sub>\<circ>"
	+ and c: "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g: "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by auto
	+ from \<psi>_f[OF that] that c f g \<FF>a have [symmetric, cat_cs_simps]:
	+ "g = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps \<psi>_NTMap_app \<FF>a_def cs_intro: cat_cs_intros
	+ )
	+ from that c f g \<FF>a show ?thesis
	+ unfolding \<FF>a_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_comma_cs_simps cat_cs_simps
	+ \<psi>_NTMap_app \<sigma>_NTMap_app \<FF>a_def
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ qed
	+ show
	+ "\<sigma>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<circ>\<^sub>A\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
	+ \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+ if "g : c \<mapsto>\<^bsub>\<JJ>\<^esub> d" for c d g
	+ proof-
	+ from that have \<FF>g: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this assms(3)] obtain e h e' h' k
	+ where \<FF>g_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = [[0, e, h]\<^sub>\<circ>, [0, e', h']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>c_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = [0, e, h]\<^sub>\<circ>"
	+ and \<FF>d_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> = [0, e', h']\<^sub>\<circ>"
	+ and k: "k : e \<mapsto>\<^bsub>\<AA>\<^esub> e'"
	+ and h: "h : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>e\<rparr>"
	+ and h': "h' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>e'\<rparr>"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> h = h'"
	+ by metis
	+ from that have "c \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" by auto
	+ from \<psi>_f[OF this] that k f h have [symmetric, cat_cs_simps]:
	+ "h = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps \<psi>_NTMap_app \<FF>c_def cs_intro: cat_cs_intros
	+ )
	+ from that have "d \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"by auto
	+ from \<psi>_f[OF this] that k f h' have [symmetric, cat_cs_simps]:
	+ "h' = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps \<psi>_NTMap_app \<FF>d_def cs_intro: cat_cs_intros
	+ )
	+ note \<tau>.cat_cone_Comp_commute[cat_cs_simps del]
	+ from \<tau>.ntcf_Comp_commute[OF that] that assms(3) k h h'
	+ have [symmetric, cat_cs_simps]: "\<tau>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = k \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_comma_cs_simps cat_cs_simps \<FF>g_def \<FF>c_def \<FF>d_def
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ from that f \<FF>g k h h' show ?thesis
	+ unfolding \<FF>g_def \<FF>c_def \<FF>d_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_comma_cs_simps cat_cs_simps
	+ \<psi>_NTMap_app \<sigma>_NTMap_app \<FF>g_def \<FF>c_def \<FF>d_def
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ qed
	+ qed
	+ (
	+ use f in
	+ \<open>
	+ cs_concl cs_shallow
	+ cs_intro: cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	+ cs_simp: cat_cs_simps
	+ \<close>
	+ )+
	+
	+ have \<tau>\<sigma>: "\<tau> = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>"
	+ proof(rule ntcf_eqI)
	+ show "\<tau> : cf_const \<JJ> \<AA> b \<mapsto>\<^sub>C\<^sub>F x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by (rule \<tau>.is_ntcf_axioms)
	+ from f show "x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> :
	+ cf_const \<JJ> \<AA> b \<mapsto>\<^sub>C\<^sub>F x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_comma_cs_simps
	+ cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	+ )
	+ have dom_lhs: "\<D>\<^sub>\<circ> (\<tau>\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ have dom_rhs: "\<D>\<^sub>\<circ> ((x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>)\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<tau>\<lparr>NTMap\<rparr> = (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>)\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems': "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ then have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> x \<down>\<^sub>C\<^sub>F \<GG>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF this assms(3)] obtain c g
	+ where \<FF>a_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = [0, c, g]\<^sub>\<circ>"
	+ and c: "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g: "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by auto
	+ from \<psi>_f[OF prems'] prems' f g have [symmetric, cat_cs_simps]:
	+ "g = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps \<psi>_NTMap_app \<FF>a_def cs_intro: cat_cs_intros
	+ )
	+ with assms(3) prems' c g f show
	+ "\<tau>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_comma_cs_simps cat_cs_simps
	+ \<FF>a_def \<psi>_NTMap_app \<sigma>_NTMap_app
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ qed (simp_all add: \<tau>.ntcf_NTMap_vsv cat_cs_intros)
	+ qed simp_all
	+
	+ from f have b_def: "b = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>"
	+ by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
	+
	+ show \<sigma>a_unique: "\<exists>!\<sigma>a. \<exists>\<sigma> a.
	+ \<sigma>a = \<langle>\<sigma>, a\<rangle> \<and>
	+ \<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG> \<and>
	+ \<tau> = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<and> b = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ proof
	+ (
	+ intro ex1I[where a=\<open>\<langle>\<sigma>, [0, b, f]\<^sub>\<circ>\<rangle>\<close>] exI conjI, simp only:;
	+ (elim exE conjE)?
	+ )
	+
	+ show "\<sigma> : [0, b, f]\<^sub>\<circ> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by (rule \<sigma>.is_cat_cone_axioms)
	+ show "\<tau> = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>" by (rule \<tau>\<sigma>)
	+ show "b = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr> \<lparr>0, b, f\<rparr>\<^sub>\<bullet>" by (rule b_def)
	+
	+ fix \<sigma>a \<sigma>' a assume prems':
	+ "\<sigma>a = \<langle>\<sigma>', a\<rangle>"
	+ "\<sigma>' : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ "\<tau> = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'"
	+ "b = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ interpret \<sigma>': is_cat_cone \<alpha> a \<JJ> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<FF> \<sigma>' by (rule prems'(2))
	+
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF \<sigma>'.cat_cone_obj assms(3)] obtain c g
	+ where a_def'': "a = [0, c, g]\<^sub>\<circ>"
	+ and c': "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g': "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by auto
	+ from prems'(4) c' g' assms(3) have bc: "b = c"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_comma_cs_simps a_def'' cs_intro: cat_comma_cs_intros
	+ )
	+ with a_def'' c' g' have a_def': "a = [0, b, g]\<^sub>\<circ>"
	+ and b: "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g: "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+ by auto
	+
	+ from prems'(3) have \<tau>_eq_x\<GG>_\<sigma>':
	+ "\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
	+ by simp
	+
	+ have "\<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> g"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ proof-
	+ from that have \<sigma>'_j: "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : [0, b, g]\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps a_def'[symmetric] cs_intro: cat_cs_intros
	+ )
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this] obtain e h k
	+ where \<sigma>'_j_def: "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = [[0, b, g]\<^sub>\<circ>, [0, e, h]\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>j_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [0, e, h]\<^sub>\<circ>"
	+ and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> e"
	+ and h: "h : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>e\<rparr>"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> g = h"
	+ by (metis \<GG>.cat_obj_cf_comma_is_arrD(4,7) \<sigma>'_j assms(3))
	+ from that \<sigma>'_j show ?thesis
	+ unfolding \<sigma>'_j_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps cat_comma_cs_simps
	+ \<sigma>'_j_def \<psi>_NTMap_app \<FF>j_def prems'(3)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+ from f_unique[OF g this] have gf: "g = f".
	+ with a_def' have a_def: "a = [0, b, f]\<^sub>\<circ>" by simp
	+
	+ have \<sigma>\<sigma>': "\<sigma> = \<sigma>'"
	+ proof(rule ntcf_eqI)
	+ show "\<sigma> : cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ show "\<sigma>' : cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) [0, b, f]\<^sub>\<circ> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by (cs_concl cs_shallow cs_simp: a_def cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> (\<sigma>'\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ show "\<sigma>\<lparr>NTMap\<rparr> = \<sigma>'\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix j assume prems'': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ then have \<sigma>'_j: "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : [0, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps a_def'[symmetric] gf[symmetric]
	+ cs_intro: cat_cs_intros
	+ )
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this] obtain e h k
	+ where \<sigma>'_j_def: "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = [[0, b, f]\<^sub>\<circ>, [0, e, h]\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>j_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [0, e, h]\<^sub>\<circ>"
	+ and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> e"
	+ and h: "h : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>e\<rparr>"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f = h"
	+ by (metis \<GG>.cat_obj_cf_comma_is_arrD(4,7) \<sigma>'_j assms(3))
	+ from prems'' k h assms(3) f h show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<sigma>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps cat_comma_cs_simps
	+ \<tau>_eq_x\<GG>_\<sigma>' \<psi>_NTMap_app \<sigma>_NTMap_app \<FF>j_def \<sigma>'_j_def
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ )
	+ qed (cs_concl cs_shallow cs_intro: V_cs_intros)
	+ qed simp_all
	+ show "\<sigma>a = \<langle>\<sigma>, [[]\<^sub>\<circ>, b, f]\<^sub>\<circ>\<rangle>" unfolding prems'(1) \<sigma>\<sigma>' a_def by simp
	+ qed
	+
	+ show "\<sigma>' : a' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ if "\<sigma>' : a' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ and "\<tau> = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'"
	+ and "b = x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	+ for \<sigma>' a'
	+ proof(rule is_cat_limitI)
	+
	+ interpret \<sigma>': is_cat_cone \<alpha> a' \<JJ> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<FF> \<sigma>' by (rule that(1))
	+
	+ from \<sigma>.is_cat_cone_axioms \<tau>\<sigma> b_def that \<sigma>a_unique have
	+ "\<langle>\<sigma>', a'\<rangle> = \<langle>\<sigma>, [0, b, f]\<^sub>\<circ>\<rangle>"
	+ by metis
	+ then have \<sigma>'_def: "\<sigma>' = \<sigma>" and a'_def: "a' = [0, b, f]\<^sub>\<circ>" by simp_all
	+
	+ show "\<sigma>' : a' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by (rule \<sigma>'.is_cat_cone_axioms)
	+
	+ fix \<sigma>'' a'' assume prems: "\<sigma>'' : a'' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ then interpret \<sigma>'': is_cat_cone \<alpha> a'' \<JJ> \<open>x \<down>\<^sub>C\<^sub>F \<GG>\<close> \<FF> \<sigma>'' .
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF \<sigma>''.cat_cone_obj assms(3)] obtain b' f'
	+ where a''_def: "a'' = [0, b', f']\<^sub>\<circ>"
	+ and b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and f': "f' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	+ by auto
	+ from b' f' have x\<GG>_A': "x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> = b'"
	+ unfolding a''_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
	+ )
	+
	+ from \<tau>.cat_lim_unique_cone'[
	+ OF cf_ntcf_comp_cf_cat_cone[OF prems x\<GG>.is_functor_axioms],
	+ unfolded x\<GG>_A'
	+ ]
	+ obtain h where h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b"
	+ and x\<GG>_\<sigma>''_app: "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'')\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h"
	+ and h_unique:
	+ "\<lbrakk>
	+ h' : b' \<mapsto>\<^bsub>\<AA>\<^esub> b;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'')\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> h'
	+ \<rbrakk> \<Longrightarrow> h' = h"
	+ for h'
	+ by metis
	+
	+ define F where "F = [a'', a', [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
	+
	+ show "\<exists>!F'.
	+ F' : a'' \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> a' \<and> \<sigma>'' = \<sigma>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F'"
	+ unfolding a''_def a'_def \<sigma>'_def
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ from f' h have \<GG>h_f': "\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros )
	+ have "\<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f')"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ proof-
	+ from that have \<sigma>''_j:
	+ "\<sigma>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : [0, b', f']\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps a''_def[symmetric]
	+ cs_intro: cat_cs_intros
	+ )
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this] obtain e h' k
	+ where \<sigma>''_j_def: "\<sigma>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = [[0, b', f']\<^sub>\<circ>, [0, e, h']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>j_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [0, e, h']\<^sub>\<circ>"
	+ and k: "k : b' \<mapsto>\<^bsub>\<AA>\<^esub> e"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f' = h'"
	+ by (metis \<GG>.cat_obj_cf_comma_is_arrD(4,7) \<sigma>''_j assms(3))
	+ from that \<sigma>''_j have \<psi>_NTMap_j: "\<psi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>''))\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f'"
	+ unfolding \<sigma>''_j_def \<FF>j_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps cat_comma_cs_simps \<sigma>''_j_def \<FF>j_def \<psi>_NTMap_app
	+ cs_intro: cat_cs_intros
	+ )+
	+ from that h f' show ?thesis
	+ unfolding \<psi>_NTMap_j
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps
	+ is_ntcf.cf_ntcf_comp_NTMap_app
	+ x\<GG>_\<sigma>''_app[OF that]
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+
	+ from f_unique[OF \<GG>h_f' this] have [cat_cs_simps]:
	+ "\<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f' = f".
	+
	+ from assms(3) h f' f show F: "F : [0, b', f']\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> [0, b, f]\<^sub>\<circ>"
	+ unfolding F_def a''_def a'_def
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros
	+ )
	+
	+ show "\<sigma>'' = \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F"
	+ proof(rule ntcf_eqI)
	+ show "\<sigma>'' : cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) a'' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ by (rule \<sigma>''.is_ntcf_axioms)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>''\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from F show "\<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F :
	+ cf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) a'' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> x \<down>\<^sub>C\<^sub>F \<GG>"
	+ unfolding a''_def by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ then have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((\<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F)\<lparr>NTMap\<rparr>) = \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show "\<sigma>''\<lparr>NTMap\<rparr> = (\<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F)\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix j assume prems': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ then have \<sigma>''_j:
	+ "\<sigma>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : [0, b', f']\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps a''_def[symmetric]
	+ cs_intro: cat_cs_intros
	+ )
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF this] obtain e h' k
	+ where \<sigma>''_j_def: "\<sigma>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = [[0, b', f']\<^sub>\<circ>, [0, e, h']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and \<FF>j_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [0, e, h']\<^sub>\<circ>"
	+ and k: "k : b' \<mapsto>\<^bsub>\<AA>\<^esub> e"
	+ and h': "h' : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>e\<rparr>"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f' = h'"
	+ by (metis \<GG>.cat_obj_cf_comma_is_arrD(4,7) \<sigma>''_j assms(3))
	+ from assms(3) prems' F k h' h f f' show
	+ "\<sigma>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F)\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by (very slow)
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps cat_comma_cs_simps
	+ \<sigma>''_j_def x\<GG>_\<sigma>''_app[OF prems', symmetric]
	+ \<sigma>_NTMap_app F_def \<FF>j_def a''_def a'_def
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ cs_simp: \<psi>_f \<psi>_NTMap_app
	+ )
	+ qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
	+ qed simp_all
	+ fix F' assume prems':
	+ "F' : [0, b', f']\<^sub>\<circ> \<mapsto>\<^bsub>x \<down>\<^sub>C\<^sub>F \<GG>\<^esub> [0, b, f]\<^sub>\<circ>"
	+ "\<sigma>'' = \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> (x \<down>\<^sub>C\<^sub>F \<GG>) F'"
	+ from \<GG>.cat_obj_cf_comma_is_arrE[OF prems'(1) assms(3), simplified]
	+ obtain k
	+ where F'_def: "F' = [[0, b', f']\<^sub>\<circ>, [0, b, f]\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	+ and k: "k : b' \<mapsto>\<^bsub>\<AA>\<^esub> b"
	+ and [cat_cs_simps]: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<XX>\<^esub> f' = f"
	+ by metis
	+ have "k = h"
	+ proof(rule h_unique[OF k])
	+ fix j assume prems'': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ then have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> \<in>\<^sub>\<circ> x \<down>\<^sub>C\<^sub>F \<GG>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from \<GG>.cat_obj_cf_comma_ObjE[OF this assms(3)] obtain c g
	+ where \<FF>j_def: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = [0, c, g]\<^sub>\<circ>"
	+ and c: "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	+ and g: "g : x \<mapsto>\<^bsub>\<XX>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by auto
	+ from prems'' prems'(1) assms(3) c g f show
	+ "(x \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>'')\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> k"
	+ unfolding prems'(2) \<tau>\<sigma> F'_def
	+ by (very slow)
	+ (
	+ cs_concl
	+ cs_simp: cat_comma_cs_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_comma_cs_intros
	+ cs_simp: \<psi>_f \<sigma>_NTMap_app \<FF>j_def
	+ )
	+ qed
	+ then show "F' = F" unfolding F'_def F_def a''_def a'_def by simp
	+ qed
	+
	+ qed
	+
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Complete.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Complete.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Complete.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Complete.thy
	@@ -1,1130 +1,1198 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	-section\<open>Completeness for categories\<close>
	+section\<open>Completeness and cocompleteness\<close>
	theory CZH_UCAT_Complete
	- imports CZH_UCAT_Limit
	+ imports
	+ CZH_UCAT_Limit
	+ CZH_UCAT_Limit_Product
	+ CZH_UCAT_Limit_Equalizer
	begin



	-subsection\<open>Small-complete category\<close>
	+subsection\<open>Limits by products and equalizers\<close>
	+
	+lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
	+ \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>; \<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb> \<rbrakk> \<Longrightarrow>
	+ \<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
	+ \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
	+ \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains r u where "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+
	+ let ?L =\<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?R =\<open>\<lambda>i. \<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<close>
	+
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
	+
	+ have "?R j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros that)
	+
	+ have "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
	+ proof(intro tm_cf_discreteI)
	+ show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros that)
	+ show "VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof-
	+ have "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ by (auto simp: \<FF>.cf_ObjMap_vdomain)
	+ moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (force intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
	+ ultimately show ?thesis by auto
	+ qed
	+ qed (auto simp: cat_small_cs_intros)
	+ show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof-
	+ have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ proof(rule vrange_VLambda_vsubset)
	+ fix x assume x: "x \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ then have "\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by (auto intro: cat_cs_intros simp: cat_cs_simps)
	+ moreover from x have "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr>\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by (simp add: \<FF>.ArrMap.vsv_vimageI2)
	+ qed
	+ moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
	+ ultimately show ?thesis by auto
	+ qed
	+ qed (auto simp: cat_small_cs_intros)
	+ qed (auto intro: cat_cs_intros)
	+
	+ from assms(3)[where A=\<open>?R\<close>, OF this] obtain P\<^sub>O \<pi>\<^sub>O
	+ where \<pi>\<^sub>O: "\<pi>\<^sub>O : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?R : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by clarsimp
	+
	+ interpret \<pi>\<^sub>O: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> ?R \<CC> P\<^sub>O \<pi>\<^sub>O by (rule \<pi>\<^sub>O)
	+
	+ have P\<^sub>O: "P\<^sub>O \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro \<pi>\<^sub>O.cat_cone_obj)
	+
	+ have "?L u \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "u \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for u
	+ proof-
	+ from that obtain a b where "u : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show ?thesis
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+
	+ have tm_cf_discrete: "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>"
	+ proof(intro tm_cf_discreteI)
	+ show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	+ proof-
	+ from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show ?thesis
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+
	+ show "(\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof-
	+ have "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ proof(rule vrange_VLambda_vsubset)
	+ fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	+ then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	+ )
	+ qed
	+ moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
	+ ultimately show ?thesis by auto
	+ qed
	+ qed (auto simp: cat_small_cs_intros)
	+
	+ show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof-
	+ have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ proof(rule vrange_VLambda_vsubset)
	+ fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	+ then obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then have "\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by (auto intro: cat_cs_intros simp: cat_cs_simps)
	+ moreover from f have
	+ "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by (simp add: \<FF>.ArrMap.vsv_vimageI2)
	+ qed
	+ moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
	+ ultimately show ?thesis by auto
	+ qed
	+ qed (auto simp: cat_small_cs_intros)
	+ qed (auto intro: cat_cs_intros)
	+
	+ from assms(4)[where A=\<open>?L\<close>, OF this, simplified] obtain P\<^sub>A \<pi>\<^sub>A
	+ where \<pi>\<^sub>A: "\<pi>\<^sub>A : P\<^sub>A <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?L : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by auto
	+
	+ interpret \<pi>\<^sub>A: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> ?L \<CC> P\<^sub>A \<pi>\<^sub>A by (rule \<pi>\<^sub>A)
	+
	+ let ?F = \<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?f = \<open>\<lambda>u. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	+ let ?\<pi>\<^sub>O' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?f\<close>
	+
	+ have \<pi>\<^sub>O': "?\<pi>\<^sub>O' :
	+ P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) (\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<CC> :
	+ :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding the_cat_discrete_components(1)
	+ proof
	+ (
	+ intro
	+ tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	+ tm_cf_discrete
	+ )
	+ fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	+ then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
	+ cs_intro: cat_cs_intros
	+ )
	+ qed (intro P\<^sub>O)
	+
	+ from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O'] obtain f'
	+ where f': "f' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	+ and \<pi>\<^sub>O'_NTMap_app:
	+ "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ and unique_f':
	+ "\<lbrakk>
	+ f'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	+ \<rbrakk> \<Longrightarrow> f'' = f'"
	+ for f''
	+ by metis
	+
	+ have \<pi>\<^sub>O_NTMap_app_Cod:
	+ "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	+ proof-
	+ from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
	+ from \<pi>\<^sub>O'_NTMap_app[OF this] that show ?thesis
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+
	+ from this[symmetric] have \<pi>\<^sub>A_NTMap_Comp_app:
	+ "\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O" for q f a b c
	+ using that f'
	+ by (intro \<FF>.HomCod.cat_assoc_helper)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )+
	+
	+ let ?g = \<open>\<lambda>u. \<FF>\<lparr>ArrMap\<rparr>\<lparr>u\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	+ let ?\<pi>\<^sub>O'' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?g\<close>
	+
	+ have \<pi>\<^sub>O'': "?\<pi>\<^sub>O'' : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding the_cat_discrete_components(1)
	+ proof
	+ (
	+ intro
	+ tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	+ tm_cf_discrete
	+ )
	+ show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	+ proof-
	+ from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show ?thesis
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps
	+ the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+ qed (intro P\<^sub>O)
	+
	+ from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O''] obtain g'
	+ where g': "g' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	+ and \<pi>\<^sub>O''_NTMap_app:
	+ "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	+ and unique_g':
	+ "\<lbrakk>
	+ g'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g''
	+ \<rbrakk> \<Longrightarrow> g'' = g'"
	+ for g''
	+ by (metis (lifting))
	+
	+ have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	+ proof-
	+ from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
	+ from \<pi>\<^sub>O''_NTMap_app[OF this] that show ?thesis
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed
	+ then have \<pi>\<^sub>O_NTMap_app_Dom:
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) =
	+ (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O" for q f a b c
	+ using that g'
	+ by (intro \<FF>.HomCod.cat_assoc_helper)
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+
	+ from assms(2)[OF f' g'] obtain E \<epsilon> where \<epsilon>:
	+ "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (P\<^sub>O,P\<^sub>A,g',f') : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by clarsimp
	+
	+ interpret \<epsilon>: is_cat_equalizer_2 \<alpha> P\<^sub>O P\<^sub>A g' f' \<CC> E \<epsilon> by (rule \<epsilon>)
	+
	+ define \<mu> where "\<mu> =
	+ [(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>), cf_const \<JJ> \<CC> E, \<FF>, \<JJ>, \<CC>]\<^sub>\<circ>"
	+
	+ have \<mu>_components:
	+ "\<mu>\<lparr>NTMap\<rparr> = (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)"
	+ "\<mu>\<lparr>NTDom\<rparr> = cf_const \<JJ> \<CC> E"
	+ "\<mu>\<lparr>NTCod\<rparr> = \<FF>"
	+ "\<mu>\<lparr>NTDGDom\<rparr> = \<JJ>"
	+ "\<mu>\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding \<mu>_def nt_field_simps by (simp_all add: nat_omega_simps)
	+
	+ have [cat_cs_simps]:
	+ "\<mu>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ for i
	+ using that unfolding \<mu>_components by simp
	+
	+ have "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ proof(intro is_cat_limitI)
	+
	+ show \<mu>: "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	+ show "vfsequence \<mu>" unfolding \<mu>_def by simp
	+ show "vcard \<mu> = 5\<^sub>\<nat>" unfolding \<mu>_def by (simp add: nat_omega_simps)
	+ show "cf_const \<JJ> \<CC> E : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	+ show "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ show "\<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : cf_const \<JJ> \<CC> E\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a
	+ using that
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps
	+ cat_discrete_cs_simps
	+ cat_parallel_cs_simps
	+ the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
	+ )
	+ show
	+ "\<mu>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	+ \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for a b f
	+ using that \<epsilon> g' f'
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_parallel_cs_simps
	+ cat_cs_simps
	+ the_cat_discrete_components(1)
	+ \<pi>\<^sub>O_NTMap_app_Cod
	+ \<pi>\<^sub>O_NTMap_app_Dom
	+ \<epsilon>.cat_eq_2_Comp_eq(1)
	+ cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
	+ )
	+
	+ qed (auto simp: \<mu>_components cat_cs_intros)
	+
	+ interpret \<mu>: is_cat_cone \<alpha> E \<JJ> \<CC> \<FF> \<mu> by (rule \<mu>)
	+
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" for u' r'
	+ proof-
	+
	+ interpret u': is_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> u' by (rule that)
	+
	+ let ?u' = \<open>\<lambda>j. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<close>
	+ let ?\<pi>' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Obj\<rparr>) ?R r' ?u'\<close>
	+
	+ have \<pi>'_NTMap_app: "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using that
	+ unfolding ntcf_obj_prod_base_components the_cat_discrete_components
	+ by auto
	+
	+ have \<pi>': "?\<pi>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC> : :\<^sub>C (\<JJ>\<lparr>Obj\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding the_cat_discrete_components(1)
	+ proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
	+ show "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
	+ proof(intro tm_cf_discreteI)
	+ show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: that cat_cs_intros)
	+ show "category \<alpha> \<CC>" by (auto intro: cat_cs_intros)
	+ from \<FF>.tm_cf_ObjMap_in_Vset show "(\<lambda>x\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto simp: \<FF>.cf_ObjMap_vdomain)
	+ show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ proof(intro vsubsetI)
	+ fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>)"
	+ then obtain i where i: "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ and x_def: "x = \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>"
	+ by auto
	+ from i have "x = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr>\<rparr>"
	+ by (simp add: x_def \<FF>.cf_ObjMap_CId)
	+ moreover from i have "\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ ultimately show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	+ by (auto intro: \<FF>.ArrMap.vsv_vimageI2)
	+ qed
	+ then show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ auto simp:
	+ \<FF>.tm_cf_ArrMap_in_Vset vrange_in_VsetI vsubset_in_VsetI
	+ )
	+ qed (auto intro: \<FF>.HomDom.tiny_cat_Obj_in_Vset)
	+ qed
	+ show "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using that
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (auto simp: cat_cs_intros)
	+
	+ from \<pi>\<^sub>O.cat_obj_prod_unique_cone'[OF this] obtain h'
	+ where h': "h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
	+ and \<pi>'_NTMap_app':
	+ "\<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	+ and unique_h': "\<And>h''.
	+ \<lbrakk>
	+ h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O;
	+ \<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''
	+ \<rbrakk> \<Longrightarrow> h'' = h'"
	+ by metis
	+
	+ interpret \<pi>':
	+ is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Obj\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) (app (\<FF>\<lparr>ObjMap\<rparr>)) \<CC>\<close> ?\<pi>'
	+ by (rule \<pi>')
	+
	+ let ?u'' = \<open>\<lambda>u. u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	+ let ?\<pi>'' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Arr\<rparr>) ?L r' ?u''\<close>
	+
	+ have \<pi>''_NTMap_app: "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	+ using that
	+ unfolding ntcf_obj_prod_base_components the_cat_discrete_components
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+
	+ have \<pi>'': "?\<pi>'' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding the_cat_discrete_components(1)
	+ proof
	+ (
	+ intro
	+ tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	+ tm_cf_discrete
	+ )
	+ fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	+ then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then show "u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ qed (simp add: cat_cs_intros)
	+
	+ from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF this] obtain h''
	+ where h'': "h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	+ and \<pi>''_NTMap_app':
	+ "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''"
	+ and unique_h'': "\<And>h'''.
	+ \<lbrakk>
	+ h''' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'''
	+ \<rbrakk> \<Longrightarrow> h''' = h''"
	+ by metis
	+
	+ interpret \<pi>'': is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>\<close> ?\<pi>''
	+ by (rule \<pi>'')
	+
	+ have g'h'_f'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	+ proof-
	+
	+ from g' h' have g'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from f' h' have f'h': "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+ have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	+ if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	+ proof-
	+ from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	+ by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
	+ also from f have "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: \<pi>'_NTMap_app cat_cs_simps cat_lim_cs_simps
	+ cs_intro: cat_cs_intros
	+ )
	+ also from f g' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps
	+ cat_discrete_cs_simps
	+ the_cat_discrete_components(1)
	+ \<pi>'_NTMap_app'
	+ \<pi>\<^sub>O_NTMap_app_Dom
	+ cs_intro: cat_cs_intros
	+ )
	+ finally show ?thesis by simp
	+ qed
	+
	+ from unique_h''[OF g'h' this, simplified] have g'h'_h'':
	+ "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
	+ have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	+ if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	+ proof-
	+ from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	+ then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	+ by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
	+ also from f have "\<dots> = ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: \<pi>'_NTMap_app cs_intro: cat_cs_intros
	+ )
	+ also from f have "\<dots> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: \<pi>'_NTMap_app' cs_intro: cat_cs_intros
	+ )
	+ also from f g' h' have "\<dots> = (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: \<pi>\<^sub>O_NTMap_app_Cod cs_intro: cat_cs_intros
	+ )
	+ also from that f' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ finally show ?thesis by simp
	+ qed
	+ from unique_h''[OF f'h' this, simplified] have f'h'_h'':
	+ "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
	+ from g'h'_h'' f'h'_h'' show ?thesis by simp
	+ qed
	+
	+ let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	+ and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f'\<close>
	+
	+ define \<epsilon>' where "\<epsilon>' =
	+ [
	+ (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'))),
	+ cf_const ?II \<CC> r',
	+ ?II_II,
	+ ?II,
	+ \<CC>
	+ ]\<^sub>\<circ>"
	+
	+ have \<epsilon>'_components:
	+ "\<epsilon>'\<lparr>NTMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')))"
	+ "\<epsilon>'\<lparr>NTDom\<rparr> = cf_const ?II \<CC> r'"
	+ "\<epsilon>'\<lparr>NTCod\<rparr> = ?II_II"
	+ "\<epsilon>'\<lparr>NTDGDom\<rparr> = ?II"
	+ "\<epsilon>'\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding \<epsilon>'_def nt_field_simps by (simp_all add: nat_omega_simps)
	+
	+ have \<epsilon>'_NTMap_app_I2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = h'" if "x = \<aa>\<^sub>P\<^sub>L\<^sub>2" for x
	+ proof-
	+ have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
	+ then show ?thesis unfolding \<epsilon>'_components that by simp
	+ qed
	+
	+ have \<epsilon>'_NTMap_app_sI2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'" if "x = \<bb>\<^sub>P\<^sub>L\<^sub>2" for x
	+ proof-
	+ have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ unfolding that by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	+ with \<epsilon>.cat_parallel_\<aa>\<bb> show ?thesis
	+ unfolding \<epsilon>'_components by (cs_concl cs_simp: V_cs_simps that)
	+ qed
	+
	+ interpret par: cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f' \<CC>
	+ by (intro cf_parallel_2I cat_parallel_2I)
	+ (simp_all add: cat_cs_intros cat_parallel_cs_intros)
	+
	+ have "\<epsilon>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	+ show "vfsequence \<epsilon>'" unfolding \<epsilon>'_def by auto
	+ show "vcard \<epsilon>' = 5\<^sub>\<nat>" unfolding \<epsilon>'_def by (simp add: nat_omega_simps)
	+ from h' show "cf_const (?II) \<CC> r' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros
	+ )
	+ from h' show "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_const ?II \<CC> r'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> ?II_II\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>" for a
	+ using that
	+ by (elim the_cat_parallel_2_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp:
	+ \<epsilon>'_NTMap_app_I2 \<epsilon>'_NTMap_app_sI2
	+ cat_cs_simps cat_parallel_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ from h' f' g'h'_f'h' show
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const ?II \<CC> r'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	+ ?II_II\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>?II\<^esub> b" for a b f
	+ using that
	+ by (elim \<epsilon>.the_cat_parallel_2_is_arrE; simp only:)
	+ (
	+ cs_concl
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ cs_simp:
	+ cat_cs_simps
	+ cat_parallel_cs_simps
	+ \<epsilon>'_NTMap_app_I2
	+ \<epsilon>'_NTMap_app_sI2
	+ )+
	+ qed
	+ (
	+ simp add: \<epsilon>'_components \|
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
	+ )+
	+ from \<epsilon>.cat_eq_2_unique_cone[OF this] obtain t'
	+ where t': "t' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ and \<epsilon>'_NTMap_app: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'"
	+ and unique_t':
	+ "\<lbrakk> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t''\<rbrakk> \<Longrightarrow>
	+ t'' = t'"
	+ for t''
	+ by metis
	+
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
	+ show [symmetric, cat_cs_simps]: "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'"
	+ proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
	+ from t' show
	+ "\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t' : cf_const \<JJ> \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u'\<lparr>NTMap\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI)
	+ show "vsv ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from t' show
	+ "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>)" for a
	+ proof-
	+ from that have "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	+ with t' show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps
	+ \<pi>'_NTMap_app
	+ cat_parallel_cs_simps
	+ the_cat_discrete_components(1)
	+ \<epsilon>'_NTMap_app[symmetric]
	+ \<epsilon>'_NTMap_app_I2
	+ \<pi>'_NTMap_app'[symmetric]
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ qed
	+ qed auto
	+ qed simp_all
	+
	+ fix t'' assume prems': "t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t''"
	+ then have u'_NTMap_app_x:
	+ "u'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'')\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	+ for x
	+ by simp
	+ have "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'')"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ using u'_NTMap_app_x[of j] prems'(1) that
	+ by
	+ (
	+ cs_prems
	+ cs_simp:
	+ cat_cs_simps
	+ cat_discrete_cs_simps
	+ cat_parallel_cs_simps
	+ the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ (simp add: \<pi>'_NTMap_app[OF that, symmetric])
	+ moreover from prems'(1) have "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_parallel_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ ultimately have [cat_cs_simps]: "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' = h'"
	+ by (intro unique_h') simp
	+ show "t'' = t'"
	+ by (rule unique_t', intro prems'(1))
	+ (cs_concl cs_shallow cs_simp: \<epsilon>'_NTMap_app_I2 cat_cs_simps)
	+ qed
	+ qed
	+
	+ qed
	+
	+ then show ?thesis using that by clarsimp
	+
	+qed
	+
	+lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
	+ \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>; \<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa> \<rbrakk> \<Longrightarrow>
	+ \<exists>E \<epsilon>. \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
	+ \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
	+ \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains r u where "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
	+ have "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ if "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" for \<aa> \<bb> \<gg> \<ff>
	+ proof-
	+ from assms(2)[OF that(1,2)] obtain E \<epsilon>
	+ where \<epsilon>: "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by clarsimp
	+ interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule \<epsilon>)
	+ from \<epsilon>.is_cat_equalizer_2_op[unfolded cat_op_simps] show ?thesis by auto
	+ qed
	+ moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A (op_cat \<CC>)" for A
	+ proof-
	+ interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
	+ from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi>
	+ where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by clarsimp
	+ interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
	+ from \<pi>.is_cat_obj_prod_op show ?thesis by auto
	+ qed
	+ moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A (op_cat \<CC>)" for A
	+ proof-
	+ interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
	+ from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi>
	+ where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by clarsimp
	+ interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
	+ from \<pi>.is_cat_obj_prod_op show ?thesis by auto
	+ qed
	+ ultimately obtain u r where u:
	+ "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by
	+ (
	+ rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
	+ OF \<FF>.is_tm_functor_op, unfolded cat_op_simps
	+ ]
	+ )
	+ interpret u: is_cat_limit \<alpha> \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> r u by (rule u)
	+ from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
	+qed
	+
	+
	+
	+subsection\<open>Small-complete and small-cocomplete category\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	locale cat_small_complete = category \<alpha> \<CC> for \<alpha> \<CC> +
	assumes cat_small_complete:
	"\<And>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow> \<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"

	locale cat_small_cocomplete = category \<alpha> \<CC> for \<alpha> \<CC> +
	assumes cat_small_cocomplete:
	"\<And>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow> \<exists>u r. u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf cat_small_complete_def[unfolded cat_small_complete_axioms_def]
	\|intro cat_small_completeI\|
	\|dest cat_small_completeD[dest]\|
	\|elim cat_small_completeE[elim]\|

	lemma cat_small_completeE'[elim]:
	assumes "cat_small_complete \<alpha> \<CC>" and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains u r where "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by auto

	mk_ide rf cat_small_cocomplete_def[unfolded cat_small_cocomplete_axioms_def]
	\|intro cat_small_cocompleteI\|
	\|dest cat_small_cocompleteD[dest]\|
	\|elim cat_small_cocompleteE[elim]\|

	lemma cat_small_cocompleteE'[elim]:
	assumes "cat_small_cocomplete \<alpha> \<CC>" and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains u r where "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by auto


	subsubsection\<open>Duality\<close>

	lemma (in cat_small_complete) cat_small_cocomplete_op[cat_op_intros]:
	"cat_small_cocomplete \<alpha> (op_cat \<CC>)"
	proof(intro cat_small_cocompleteI)
	fix \<FF> \<JJ> assume "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	then interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<open>op_cat \<CC>\<close> \<FF> .
	from cat_small_complete[OF \<FF>.is_tm_functor_op[unfolded cat_op_simps]]
	obtain u r where u: "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by auto
	then interpret u: is_cat_limit \<alpha> \<open>op_cat \<JJ>\<close> \<CC> \<open>op_cf \<FF>\<close> r u .
	from u.is_cat_colimit_op[unfolded cat_op_simps] show
	"\<exists>u r. u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by auto
	qed (auto intro: cat_cs_intros)

	lemmas [cat_op_intros] = cat_small_complete.cat_small_cocomplete_op

	lemma (in cat_small_cocomplete) cat_small_complete_op[cat_op_intros]:
	"cat_small_complete \<alpha> (op_cat \<CC>)"
	proof(intro cat_small_completeI)
	fix \<FF> \<JJ> assume prems: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	then interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<open>op_cat \<CC>\<close> \<FF> .
	from cat_small_cocomplete[OF \<FF>.is_tm_functor_op[unfolded cat_op_simps]]
	obtain u r where u: "u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by auto
	interpret u: is_cat_colimit \<alpha> \<open>op_cat \<JJ>\<close> \<CC> \<open>op_cf \<FF>\<close> r u by (rule u)
	from u.is_cat_limit_op[unfolded cat_op_simps] show
	"\<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by auto
	qed (auto intro: cat_cs_intros)

	lemmas [cat_op_intros] = cat_small_cocomplete.cat_small_complete_op


	subsubsection\<open>A category with equalizers and small products is small-complete\<close>

	lemma (in category) cat_small_complete_if_eq_and_obj_prod:
	\<comment>\<open>See Corollary 2 in Chapter V-2 in \cite{mac_lane_categories_2010}\<close>
	assumes "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>; \<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb> \<rbrakk> \<Longrightarrow>
	\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>A I. tm_cf_discrete \<alpha> I A \<CC> \<Longrightarrow> \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cat_small_complete \<alpha> \<CC>"
	proof(intro cat_small_completeI)
	fix \<FF> \<JJ> assume prems: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	then interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> .
	show "\<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (rule cat_limit_of_cat_prod_obj_and_cat_equalizer[OF prems assms(1)])
	(auto intro: assms(2))
	qed (auto simp: cat_cs_intros)

	lemma (in category) cat_small_cocomplete_if_eq_and_obj_prod:
	assumes "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>; \<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa> \<rbrakk> \<Longrightarrow>
	\<exists>E \<epsilon>. \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<And>A I. tm_cf_discrete \<alpha> I A \<CC> \<Longrightarrow> \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "cat_small_cocomplete \<alpha> \<CC>"
	proof-
	have "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	if "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" for \<aa> \<bb> \<gg> \<ff>
	proof-
	from assms(1)[OF that] obtain \<epsilon> E where
	\<epsilon>: "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by clarsimp
	interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule \<epsilon>)
	from \<epsilon>.is_cat_equalizer_2_op show ?thesis by auto
	qed
	moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	if "tm_cf_discrete \<alpha> I A (op_cat \<CC>)" for A I
	proof-
	interpret tm_cf_discrete \<alpha> I A \<open>op_cat \<CC>\<close> by (rule that)
	from assms(2)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi>
	where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by auto
	interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> P \<pi> by (rule \<pi>)
	from \<pi>.is_cat_obj_prod_op show ?thesis by auto
	qed
	ultimately interpret cat_small_complete \<alpha> \<open>op_cat \<CC>\<close>
	by
	(
	rule category.cat_small_complete_if_eq_and_obj_prod[
	OF category_op, unfolded cat_op_simps
	]
	)
	show ?thesis by (rule cat_small_cocomplete_op[unfolded cat_op_simps])
	qed


	subsubsection\<open>
	-Existence of the initial and terminal objects in small-complete categories
	+Existence of the initial and terminal objects in
	+small-complete and small-cocomplete categories
	\<close>

	lemma (in cat_small_complete) cat_sc_ex_obj_initial:
	\<comment>\<open>See Theorem 1 in Chapter V-6 in \cite{mac_lane_categories_2010}.\<close>
	assumes "A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>f a. a \<in>\<^sub>\<circ> A \<and> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	obtains z where "obj_initial \<CC> z"
	proof-

	interpret tcd: tm_cf_discrete \<alpha> A id \<CC>
	proof(intro tm_cf_discreteI)
	show "(\<lambda>i\<in>\<^sub>\<circ>A. \<CC>\<lparr>CId\<rparr>\<lparr>id i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding id_def
	proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	from assms(1) have "A \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<CC>\<lparr>CId\<rparr>)" by (simp add: cat_CId_vdomain)
	then have "\<R>\<^sub>\<circ> (VLambda A (app (\<CC>\<lparr>CId\<rparr>))) = \<CC>\<lparr>CId\<rparr> `\<^sub>\<circ> A" by auto
	moreover have "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>A. Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
	by (rule cat_Hom_vifunion_in_Vset[OF assms(1,1,2,2)])
	moreover have "\<CC>\<lparr>CId\<rparr> `\<^sub>\<circ> A \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>A. Hom \<CC> a b)"
	proof(intro vsubsetI)
	fix f assume "f \<in>\<^sub>\<circ> \<CC>\<lparr>CId\<rparr> `\<^sub>\<circ> A"
	then obtain a where a: "a \<in>\<^sub>\<circ> A" and f_def: "f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>" by auto
	from assms(1) a show "f \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>A. Hom \<CC> a b)"
	unfolding f_def by (intro vifunionI) (auto simp: cat_CId_is_arr)
	qed
	ultimately show "\<R>\<^sub>\<circ> (VLambda A (app (\<CC>\<lparr>CId\<rparr>))) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	qed (simp_all add: assms(2))
	qed
	(
	use assms in
	\<open>auto simp: assms(2) Limit_vid_on_in_Vset intro: cat_cs_intros\<close>
	)

	have tcd: ":\<rightarrow>: A id \<CC> : :\<^sub>C A \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	by
	(
	cs_concl cs_shallow cs_intro:
	cat_small_cs_intros
	cat_cs_intros
	cat_small_discrete_cs_intros
	cat_discrete_cs_intros
	)
	from cat_small_complete[OF this] obtain \<pi> w
	where "\<pi> : w <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m :\<rightarrow>: A id \<CC> : :\<^sub>C A \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by auto
	then interpret \<pi>: is_cat_obj_prod \<alpha> A id \<CC> w \<pi>
	by (intro is_cat_obj_prodI tcd.cf_discrete_axioms)

	let ?ww = \<open>Hom \<CC> w w\<close>

	- have CId_w: "\<CC>\<lparr>CId\<rparr>\<lparr>w\<rparr> \<in>\<^sub>\<circ> Hom \<CC> w w"
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_lim_cs_intros)
	- then have ww_neq_vempty: "Hom \<CC> w w \<noteq> 0" by force
	+ have CId_w: "\<CC>\<lparr>CId\<rparr>\<lparr>w\<rparr> \<in>\<^sub>\<circ> ?ww"
	+ by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	+ then have ww_neq_vempty: "?ww \<noteq> 0" by force

	have wd: "\<exists>h. h : w \<mapsto>\<^bsub>\<CC>\<^esub> d" if "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for d
	proof-
	from assms(3)[OF that] obtain g a where a: "a \<in>\<^sub>\<circ> A" and g: "g : a \<mapsto>\<^bsub>\<CC>\<^esub> d"
	by clarsimp
	from \<pi>.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components, OF a] a g
	have "\<pi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : w \<mapsto>\<^bsub>\<CC>\<^esub> a"
	by
	(
	cs_prems cs_shallow cs_simp:
	id_apply the_cat_discrete_components(1)
	cat_discrete_cs_simps cat_cs_simps
	)
	with g have "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : w \<mapsto>\<^bsub>\<CC>\<^esub> d"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	then show ?thesis by (intro exI)
	qed

	have "cf_parallel \<alpha> (\<aa>\<^sub>P\<^sub>L ?ww) (\<bb>\<^sub>P\<^sub>L ?ww) ?ww w w (vid_on ?ww) \<CC>"
	by (intro cat_cf_parallel_\<aa>\<bb> \<pi>.cat_cone_obj cat_Hom_in_Vset) simp_all
	then have "\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L ?ww) (\<bb>\<^sub>P\<^sub>L ?ww) ?ww w w (vid_on ?ww) :
	\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L ?ww) (\<bb>\<^sub>P\<^sub>L ?ww) ?ww \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	by (intro cf_parallel.cf_parallel_the_cf_parallel_is_tm_functor)
	from cat_small_complete[OF this] obtain \<epsilon> v where \<epsilon>: "\<epsilon> :
	v <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L ?ww) (\<bb>\<^sub>P\<^sub>L ?ww) ?ww w w (vid_on ?ww) :
	\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L ?ww) (\<bb>\<^sub>P\<^sub>L ?ww) ?ww \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by clarsimp
	from is_cat_equalizerI[
	OF
	this
	_
	cat_Hom_in_Vset[OF \<pi>.cat_cone_obj \<pi>.cat_cone_obj]
	ww_neq_vempty
	]
	interpret \<epsilon>: is_cat_equalizer \<alpha> w w ?ww \<open>vid_on ?ww\<close> \<CC> v \<epsilon> by auto
	note \<epsilon>_is_monic_arr =
	is_cat_equalizer.cat_eq_is_monic_arr[OF \<epsilon>.is_cat_equalizer_axioms]
	note \<epsilon>_is_monic_arrD = is_monic_arrD[OF \<epsilon>_is_monic_arr]

	show ?thesis
	proof(rule, intro obj_initialI)

	show "v \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (rule \<epsilon>.cat_cone_obj)
	then have CId_v: "\<CC>\<lparr>CId\<rparr>\<lparr>v\<rparr> : v \<mapsto>\<^bsub>\<CC>\<^esub> v"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	fix d assume prems: "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from wd[OF prems] obtain h where h: "h : w \<mapsto>\<^bsub>\<CC>\<^esub> d" by auto

	show "\<exists>!f. f : v \<mapsto>\<^bsub>\<CC>\<^esub> d"
	proof(rule ex1I)
	define f where "f = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>"
	from \<epsilon>_is_monic_arrD(1) h show f: "f : v \<mapsto>\<^bsub>\<CC>\<^esub> d"
	unfolding f_def by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	fix g assume prems': "g : v \<mapsto>\<^bsub>\<CC>\<^esub> d"
	have "cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L v d g f \<CC>"
	by (intro cat_cf_parallel_2_cat_equalizer prems' f)
	then have "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L v d g f :
	\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	by (intro cf_parallel_2.cf_parallel_2_the_cf_parallel_2_is_tm_functor)
	from cat_small_complete[OF this] obtain \<epsilon>' u
	where "\<epsilon>' :
	u <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L v d g f :
	\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by clarsimp
	from is_cat_equalizer_2I[OF this prems' f] interpret \<epsilon>':
	is_cat_equalizer_2 \<alpha> v d g f \<CC> u \<epsilon>'.
	note \<epsilon>'_is_monic_arr = is_cat_equalizer_2.cat_eq_2_is_monic_arr[
	OF \<epsilon>'.is_cat_equalizer_2_axioms
	]
	note \<epsilon>'_is_monic_arrD = is_monic_arrD[OF \<epsilon>'_is_monic_arr]
	then have "u \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	from wd[OF this] obtain s where s: "s : w \<mapsto>\<^bsub>\<CC>\<^esub> u" by clarsimp
	from s \<epsilon>'_is_monic_arrD(1) \<epsilon>_is_monic_arrD(1) have \<epsilon>\<epsilon>'s:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s : w \<mapsto>\<^bsub>\<CC>\<^esub> w"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from s \<epsilon>'_is_monic_arrD(1) \<epsilon>_is_monic_arrD(1) have \<epsilon>'s\<epsilon>:
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L (Hom \<CC> w w)\<rparr> : v \<mapsto>\<^bsub>\<CC>\<^esub> v"
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> : v \<mapsto>\<^bsub>\<CC>\<^esub> v"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from \<epsilon>_is_monic_arrD(1) \<epsilon>'_is_monic_arrD(1) s have
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>) =
	\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	also from
	\<epsilon>.cat_eq_Comp_eq
	[
	unfolded in_Hom_iff, OF cat_CId_is_arr[OF \<pi>.cat_cone_obj] \<epsilon>\<epsilon>'s,
	symmetric
	]
	\<epsilon>\<epsilon>'s \<pi>.cat_cone_obj \<epsilon>_is_monic_arr(1)
	have "\<dots> = \<CC>\<lparr>CId\<rparr>\<lparr>w\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>"
	by (cs_prems cs_shallow cs_simp: vid_on_atI cs_intro: cat_cs_intros)
	also from \<epsilon>.cf_parallel_\<aa>' \<epsilon>_is_monic_arrD(1) have
	"\<dots> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>v\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	finally have
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>) =
	\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>v\<rparr>".
	from
	is_monic_arrD(2)[OF \<epsilon>_is_monic_arr \<epsilon>'s\<epsilon> CId_v this]
	\<epsilon>'_is_monic_arrD(1) s \<epsilon>_is_monic_arrD(1)
	have \<epsilon>'s\<epsilon>_is_CId:
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (s \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L ?ww\<rparr>) = \<CC>\<lparr>CId\<rparr>\<lparr>v\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- have \<epsilon>'_is_arr_isomorphism: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : u \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> v"
	+ have \<epsilon>'_is_iso_arr: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : u \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> v"
	by
	(
	intro
	- cat_is_arr_isomorphism_if_is_monic_arr_is_right_inverse
	+ cat_is_iso_arr_if_is_monic_arr_is_right_inverse
	\<epsilon>'_is_monic_arr,
	rule is_right_inverseI[OF _ \<epsilon>'_is_monic_arrD(1) \<epsilon>'s\<epsilon>_is_CId]
	)
	(
	use s \<epsilon>_is_monic_arrD(1) in
	\<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>
	)
	from \<epsilon>'.cat_eq_2_Comp_eq(1) have
	"g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub> =
	f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<inverse>\<^sub>C\<^bsub>\<CC>\<^esub>"
	by simp
	- from this f \<epsilon>'_is_monic_arrD(1) \<epsilon>'_is_arr_isomorphism prems' show "g = f"
	+ from this f \<epsilon>'_is_monic_arrD(1) \<epsilon>'_is_iso_arr prems' show "g = f"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	qed

	qed

	qed

	lemma (in cat_small_cocomplete) cat_sc_ex_obj_terminal:
	\<comment>\<open>See Theorem 1 in Chapter V-6 in \cite{mac_lane_categories_2010}.\<close>
	assumes "A \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "A \<in>\<^sub>\<circ> Vset \<alpha>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<exists>f a. a \<in>\<^sub>\<circ> A \<and> f : c \<mapsto>\<^bsub>\<CC>\<^esub> a"
	obtains z where "obj_terminal \<CC> z"
	using that
	by
	(
	rule cat_small_complete.cat_sc_ex_obj_initial[
	OF cat_small_complete_op, unfolded cat_op_simps, OF assms, simplified
	]
	)


	+subsubsection\<open>Creation of limits, continuity and completeness\<close>

	-subsection\<open>Finite-complete category\<close>
	+lemma
	+ \<comment>\<open>See Theorem 2 in Chapter V-4 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "cat_small_complete \<alpha> \<BB>"
	+ and "\<And>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA> \<Longrightarrow> \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<And>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA> \<Longrightarrow> cf_creates_limits \<alpha> \<GG> \<FF>"
	+ shows is_tm_cf_continuous_if_cf_creates_limits: "is_tm_cf_continuous \<alpha> \<GG>"
	+ and cat_small_complete_if_cf_creates_limits: "cat_small_complete \<alpha> \<AA>"
	+proof-
	+
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	+ interpret \<BB>: cat_small_complete \<alpha> \<BB> by (rule assms(2))
	+
	+ show "is_tm_cf_continuous \<alpha> \<GG>"
	+ proof(intro is_tm_cf_continuousI, rule assms)
	+ fix \<FF> \<JJ> assume prems: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<AA> \<FF> .
	+ from cat_small_completeD(2)[OF assms(2) assms(3)[OF prems]] obtain \<psi> r
	+ where \<psi>: "\<psi> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by clarsimp
	+ show "cf_preserves_limits \<alpha> \<GG> \<FF>"
	+ by
	+ (
	+ rule cf_preserves_limits_if_cf_creates_limits,
	+ rule assms(1),
	+ rule \<FF>.is_functor_axioms,
	+ rule \<psi>,
	+ rule assms(4)[OF prems]
	+ )
	+ qed
	+
	+ show "cat_small_complete \<alpha> \<AA>"
	+ proof(intro cat_small_completeI \<GG>.HomDom.category_axioms)
	+ fix \<FF> \<JJ> assume prems: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<AA> \<FF> .
	+ from cat_small_completeD(2)[OF assms(2) assms(3)[OF prems]] obtain \<psi> r
	+ where \<psi>: "\<psi> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by clarsimp
	+ from cf_creates_limitsE''[
	+ OF assms(4)[OF prems] \<psi> \<FF>.is_functor_axioms assms(1)
	+ ]
	+ show "\<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by metis
	+ qed
	+
	+qed
	+
	+
	+
	+subsection\<open>Finite-complete and finite-cocomplete category\<close>

	locale cat_finite_complete = category \<alpha> \<CC> for \<alpha> \<CC> +
	assumes cat_finite_complete:
	"\<And>\<FF> \<JJ>. \<lbrakk> finite_category \<alpha> \<JJ>; \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow>
	\<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"

	locale cat_finite_cocomplete = category \<alpha> \<CC> for \<alpha> \<CC> +
	assumes cat_finite_cocomplete:
	"\<And>\<FF> \<JJ>. \<lbrakk> finite_category \<alpha> \<JJ>; \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow>
	\<exists>u r. u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"


	text\<open>Rules.\<close>

	mk_ide rf cat_finite_complete_def[unfolded cat_finite_complete_axioms_def]
	\|intro cat_finite_completeI\|
	\|dest cat_finite_completeD[dest]\|
	\|elim cat_finite_completeE[elim]\|

	lemma cat_finite_completeE'[elim]:
	assumes "cat_finite_complete \<alpha> \<CC>"
	and "finite_category \<alpha> \<JJ>"
	and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains u r where "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by auto

	mk_ide rf cat_finite_cocomplete_def[unfolded cat_finite_cocomplete_axioms_def]
	\|intro cat_finite_cocompleteI\|
	\|dest cat_finite_cocompleteD[dest]\|
	\|elim cat_finite_cocompleteE[elim]\|

	lemma cat_finite_cocompleteE'[elim]:
	assumes "cat_finite_cocomplete \<alpha> \<CC>"
	and "finite_category \<alpha> \<JJ>"
	and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains u r where "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms by auto


	text\<open>Elementary properties.\<close>

	sublocale cat_small_complete \<subseteq> cat_finite_complete
	proof(intro cat_finite_completeI)
	fix \<FF> \<JJ> assume prems: "finite_category \<alpha> \<JJ>" "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	interpret \<FF>: is_functor \<alpha> \<JJ> \<CC> \<FF> by (rule prems(2))
	from cat_small_complete_axioms show "\<exists>u r. u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: \<FF>.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
	qed (auto intro: cat_cs_intros)

	sublocale cat_small_cocomplete \<subseteq> cat_finite_cocomplete
	proof(intro cat_finite_cocompleteI)
	fix \<FF> \<JJ> assume prems: "finite_category \<alpha> \<JJ>" "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	interpret \<FF>: is_functor \<alpha> \<JJ> \<CC> \<FF> by (rule prems(2))
	from cat_small_cocomplete_axioms show "\<exists>u r. u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (auto intro: \<FF>.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
	qed (auto intro: cat_cs_intros)

	-
	-
	-subsection\<open>Discrete functor with tiny maps to the category \<open>Set\<close>\<close>
	-
	-lemma (in \<Z>) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
	- assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	- shows "tm_cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	-proof(intro tm_cf_discreteI)
	- from assms have vrange_F_in_Vset: "\<R>\<^sub>\<circ> (VLambda I F) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (auto intro: vrange_in_VsetI)
	- show "(\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- from assms show "\<D>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (metis vdomain_VLambda vdomain_in_VsetI)
	- define Q where
	- "Q i =
	- (
	- if i = 0
	- then VPow ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i))
	- else set (F ` elts I)
	- )"
	- for i :: V
	- have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	- proof(intro vsubsetI, unfold cat_Set_components)
	- fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. VLambda (Vset \<alpha>) id_Set\<lparr>F i\<rparr>)"
	- then obtain i where i: "i \<in>\<^sub>\<circ> I"
	- and y_def: "y = VLambda (Vset \<alpha>) id_Set\<lparr>F i\<rparr>"
	- by auto
	- from i have "F i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I F)" by auto
	- with vrange_F_in_Vset have "F i \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	- then have y_def: "y = id_Set (F i)" unfolding y_def by auto
	- show "y \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	- unfolding y_def
	- proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	- show "\<D>\<^sub>\<circ> (id_Rel (F i)) = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	- by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
	- fix j assume "j \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	- then consider \<open>j = 0\<close> \| \<open>j = 1\<^sub>\<nat>\<close> \| \<open>j = 2\<^sub>\<nat>\<close> by auto
	- then show "id_Rel (F i)\<lparr>j\<rparr> \<in>\<^sub>\<circ> Q j"
	- proof cases
	- case 1
	- from i show ?thesis
	- unfolding 1
	- by
	- (
	- subst arr_field_simps(1)[symmetric],
	- unfold id_Rel_components Q_def
	- )
	- force
	- next
	- case 2
	- from i show ?thesis
	- unfolding 2
	- by
	- (
	- subst arr_field_simps(2)[symmetric],
	- unfold id_Rel_components Q_def
	- )
	- auto
	- next
	- case 3
	- from i show ?thesis
	- unfolding 3
	- by
	- (
	- subst arr_field_simps(3)[symmetric],
	- unfold id_Rel_components Q_def
	- )
	- auto
	- qed
	- qed (auto simp: id_Rel_def cat_Set_cs_intros)
	- qed
	- moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule Limit_vproduct_in_VsetI)
	- show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>" unfolding three[symmetric] by simp
	- from assms have "VPow ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by
	- (
	- intro
	- Limit_VPow_in_VsetI
	- Limit_vtimes_in_VsetI
	- Limit_vifunion_in_Vset_if_VLambda_in_VsetI
	- )
	- auto
	- then show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	- using that vrange_VLambda
	- by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
	- qed auto
	- ultimately show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (meson vsubset_in_VsetI)
	- qed auto
	- fix i assume prems: "i \<in>\<^sub>\<circ> I"
	- from assms have "\<R>\<^sub>\<circ> (VLambda I F) \<in>\<^sub>\<circ> Vset \<alpha>" by (auto simp: vrange_in_VsetI)
	- moreover from prems have "F i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I F)" by auto
	- ultimately show "F i \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" unfolding cat_Set_components by auto
	-qed (cs_concl cs_shallow cs_intro: cat_cs_intros assms)+
	-
	-
	-
	-subsection\<open>Product cone for the category \<open>Set\<close>\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-definition ntcf_Set_obj_prod :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	- where "ntcf_Set_obj_prod \<alpha> I F = ntcf_obj_prod_base
	- (cat_Set \<alpha>) I F (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) (\<lambda>i. vprojection_arrow I F i)"
	-
	-
	-text\<open>Components.\<close>
	-
	-lemma ntcf_Set_obj_prod_components:
	- shows "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTMap\<rparr> =
	- (\<lambda>i\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. vprojection_arrow I F i)"
	- and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDom\<rparr> =
	- cf_const (:\<^sub>C I) (cat_Set \<alpha>) (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	- and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTCod\<rparr> = :\<rightarrow>: I F (cat_Set \<alpha>)"
	- and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	- and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	- unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all
	-
	-
	-subsubsection\<open>Natural transformation map\<close>
	-
	-mk_VLambda ntcf_Set_obj_prod_components(1)
	- \|vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]\|
	- \|vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]\|
	- \|app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]\|
	-
	-
	-subsubsection\<open>Product cone for the category \<open>Set\<close> is a universal cone\<close>
	-
	-lemma (in \<Z>) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
	- \<comment>\<open>See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	- assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	- shows "ntcf_Set_obj_prod \<alpha> I F : (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	-proof(intro is_cat_obj_prodI is_cat_limitI)
	-
	- interpret Set: tm_cf_discrete \<alpha> I F \<open>cat_Set \<alpha>\<close>
	- by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])
	-
	- let ?F = \<open>ntcf_Set_obj_prod \<alpha> I F\<close>
	-
	- show "cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	- by (auto simp: cat_small_discrete_cs_intros)
	- show F_is_cat_cone: "?F :
	- (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F (cat_Set \<alpha>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- unfolding ntcf_Set_obj_prod_def
	- proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
	- show "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	- unfolding cat_Set_components
	- by
	- (
	- intro
	- Limit_vproduct_in_Vset_if_VLambda_in_VsetI
	- Set.tm_cf_discrete_ObjMap_in_Vset
	- )
	- auto
	- qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)
	-
	- interpret F: is_cat_cone
	- \<alpha> \<open>\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i\<close> \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<open>?F\<close>
	- by (rule F_is_cat_cone)
	-
	- fix \<pi>' P' assume prems:
	- "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F (cat_Set \<alpha>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	-
	- let ?\<pi>'i = \<open>\<lambda>i. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<close>
	- let ?up' = \<open>cat_Set_obj_prod_up I F P' ?\<pi>'i\<close>
	-
	- interpret \<pi>': is_cat_cone \<alpha> P' \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<pi>'
	- by (rule prems(1))
	-
	- show "\<exists>!f'.
	- f' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<and>
	- \<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f'"
	- proof(intro ex1I conjI; (elim conjE)?)
	- show up': "?up' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	- proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
	- show "P' \<in>\<^sub>\<circ> Vset \<alpha>" by (auto intro: cat_cs_intros cat_lim_cs_intros)
	- fix i assume "i \<in>\<^sub>\<circ> I"
	- then show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp:
	- the_cat_discrete_components(1)
	- cat_cs_simps cat_discrete_cs_simps
	- cs_intro: cat_cs_intros
	- )
	- qed (rule assms)
	-
	- then have P': "P' \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (auto intro: cat_cs_intros cat_lim_cs_intros)
	-
	- have \<pi>'i_i: "?\<pi>'i i : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i" if "i \<in>\<^sub>\<circ> I" for i
	- using
	- \<pi>'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
	- that
	- by
	- (
	- cs_prems cs_shallow cs_simp:
	- cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	- )
	- from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) \<pi>'i_i] have \<pi>'i:
	- "cat_Set_obj_prod_up I F P' ?\<pi>'i : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)".
	-
	- show "\<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up'"
	- proof(rule ntcf_eqI, rule \<pi>'.is_ntcf_axioms)
	-
	- from F_is_cat_cone \<pi>'i show
	- "?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' :
	- cf_const (:\<^sub>C I) (cat_Set \<alpha>) P' \<mapsto>\<^sub>C\<^sub>F :\<rightarrow>: I F (cat_Set \<alpha>) :
	- :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	-
	- have dom_lhs: "\<D>\<^sub>\<circ> (\<pi>'\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from F_is_cat_cone \<pi>'i have dom_rhs:
	- "\<D>\<^sub>\<circ> ((?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	- show "\<pi>'\<lparr>NTMap\<rparr> = (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix i assume prems': "i \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>"
	- then have i: "i \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
	- have [cat_cs_simps]:
	- "vprojection_arrow I F i \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?up' = \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	- by
	- (
	- rule cat_Set_cf_comp_proj_obj_prod_up[
	- OF P' assms \<pi>'i_i i, symmetric
	- ]
	- )
	- auto
	- from \<pi>'i prems' show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> =
	- (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
	- )
	- qed (auto simp: cat_cs_intros)
	-
	- qed simp_all
	-
	- fix f' assume prems:
	- "f' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	- "\<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f'"
	- from prems(2) have \<pi>'_eq_F_f': "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	- (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f')\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	- if "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> P'" for i a
	- by simp
	- have [cat_Set_cs_simps]: "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr>"
	- if "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> P'" for i a
	- using
	- \<pi>'_eq_F_f'[OF that]
	- assms prems that
	- vprojection_arrow_is_arr[OF that(1) assms]
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp:
	- cat_Set_cs_simps
	- cat_cs_simps
	- vprojection_arrow_app
	- the_cat_discrete_components(1)
	- cs_intro: cat_Set_cs_intros cat_cs_intros
	- )
	-
	- note f' = cat_Set_is_arrD[OF prems(1)]
	- note up' = cat_Set_is_arrD[OF up']
	-
	- interpret f': arr_Set \<alpha> f' by (rule f'(1))
	- interpret u': arr_Set \<alpha> \<open>(cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>)))\<close>
	- by (rule up'(1))
	-
	- show "f' = ?up'"
	- proof(rule arr_Set_eqI[of \<alpha>])
	- have dom_lhs: "\<D>\<^sub>\<circ> (f'\<lparr>ArrVal\<rparr>) = P'"
	- by (simp add: cat_Set_cs_simps cat_cs_simps f')
	- have dom_rhs:
	- "\<D>\<^sub>\<circ> (cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>) = P'"
	- by (simp add: cat_Set_cs_simps cat_cs_simps up')
	- show "f'\<lparr>ArrVal\<rparr> = cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix a assume prems': "a \<in>\<^sub>\<circ> P'"
	- from prems(1) prems' have "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	- by (cs_concl cs_shallow cs_intro: cat_Set_cs_intros)
	- note f'a = vproductD[OF this]
	- from prems' have dom_rhs:
	- "\<D>\<^sub>\<circ> (cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) = I"
	- by (cs_concl cs_shallow cs_simp: cat_Set_cs_simps)
	- show "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	- cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	- proof(rule vsv_eqI, unfold f'a dom_rhs)
	- fix i assume "i \<in>\<^sub>\<circ> I"
	- with prems' show "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> =
	- cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_Set_cs_simps)
	- qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
	- qed auto
	- qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))
	-
	- qed
	-
	-qed
	-
	-
	-
	-subsection\<open>Equalizer for the category \<open>Set\<close>\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-abbreviation ntcf_Set_equalizer_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	- where "ntcf_Set_equalizer_map \<alpha> a g f i \<equiv>
	- (
	- i = \<aa>\<^sub>P\<^sub>L\<^sub>2 ?
	- incl_Set (vequalizer a g f) a :
	- g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer a g f) a
	- )"
	-
	-definition ntcf_Set_equalizer :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	- where "ntcf_Set_equalizer \<alpha> a b g f = ntcf_equalizer_base
	- (cat_Set \<alpha>) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map \<alpha> a g f)"
	-
	-
	-text\<open>Components.\<close>
	-
	-context
	- fixes a g f \<alpha> :: V
	-begin
	-
	-lemmas ntcf_Set_equalizer_components =
	- ntcf_equalizer_base_components[
	- where \<CC>=\<open>cat_Set \<alpha>\<close>
	- and e=\<open>ntcf_Set_equalizer_map \<alpha> a g f\<close>
	- and E=\<open>vequalizer a g f\<close>
	- and \<aa>=a and \<gg>=g and \<ff>=f,
	- folded ntcf_Set_equalizer_def
	- ]
	-
	-end
	-
	-
	-subsubsection\<open>Natural transformation map\<close>
	-
	-mk_VLambda ntcf_Set_equalizer_components(1)
	- \|vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]\|
	- \|vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]\|
	- \|app ntcf_Set_equalizer_NTMap_app\|
	-
	-lemma ntcf_Set_equalizer_2_NTMap_app_\<aa>[cat_Set_cs_simps]:
	- assumes "x = \<aa>\<^sub>P\<^sub>L\<^sub>2"
	- shows
	- "ntcf_Set_equalizer \<alpha> a b g f\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	- incl_Set (vequalizer a g f) a"
	- unfolding assms the_cat_parallel_2_components(1) ntcf_Set_equalizer_components
	- by simp
	-
	-lemma ntcf_Set_equalizer_2_NTMap_app_\<bb>[cat_Set_cs_simps]:
	- assumes "x = \<bb>\<^sub>P\<^sub>L\<^sub>2"
	- shows
	- "ntcf_Set_equalizer \<alpha> a b g f\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	- g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer a g f) a"
	- unfolding assms the_cat_parallel_2_components(1) ntcf_Set_equalizer_components
	- using cat_PL2_ineq
	- by auto
	-
	-
	-subsubsection\<open>Equalizer for the category \<open>Set\<close> is an equalizer\<close>
	-
	-lemma (in \<Z>) ntcf_Set_equalizer_2_is_cat_equalizer_2:
	- assumes "\<gg> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	- shows "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> :
	- vequalizer \<aa> \<gg> \<ff> <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	-proof(intro is_cat_equalizer_2I is_cat_equalizerI is_cat_limitI)
	-
	- let ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F (cat_Set \<alpha>) \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	- and ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	-
	- note \<gg> = cat_Set_is_arrD[OF assms(1)]
	- interpret \<gg>: arr_Set \<alpha> \<gg>
	- rewrites "\<gg>\<lparr>ArrDom\<rparr> = \<aa>" and "\<gg>\<lparr>ArrCod\<rparr> = \<bb>"
	- by (rule \<gg>(1)) (simp_all add: \<gg>)
	- note \<ff> = cat_Set_is_arrD[OF assms(2)]
	- interpret \<ff>: arr_Set \<alpha> \<ff>
	- rewrites "\<ff>\<lparr>ArrDom\<rparr> = \<aa>" and "\<ff>\<lparr>ArrCod\<rparr> = \<bb>"
	- by (rule \<ff>(1)) (simp_all add: \<ff>)
	-
	- note [cat_Set_cs_intros] = \<gg>.arr_Set_ArrDom_in_Vset \<ff>.arr_Set_ArrCod_in_Vset
	-
	- let ?incl = \<open>incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa>\<close>
	-
	- show \<aa>\<bb>\<gg>\<ff>_is_cat_cone: "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> :
	- vequalizer \<aa> \<gg> \<ff> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- unfolding ntcf_Set_equalizer_def
	- proof
	- (
	- intro
	- category.cat_ntcf_equalizer_base_is_cat_cone
	- category.cat_cf_parallel_2_cat_equalizer
	- )
	- from assms show
	- "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) :
	- vequalizer \<aa> \<gg> \<ff> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: V_cs_simps
	- cs_intro:
	- V_cs_intros cat_Set_cs_intros cat_cs_intros
	- cat_PL2_ineq[symmetric]
	- )
	- show
	- "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) =
	- \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<aa>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	- by
	- (
	- cs_concl
	- cs_simp: V_cs_simps
	- cs_intro:
	- V_cs_intros cat_Set_cs_intros cat_cs_intros
	- cat_PL2_ineq[symmetric]
	- )
	- from assms show
	- "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) =
	- \<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<aa>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	- by
	- (
	- cs_concl
	- cs_simp: V_cs_simps cat_Set_incl_Set_commute
	- cs_intro: V_cs_intros cat_PL2_ineq[symmetric]
	- )
	- qed
	- (
	- cs_concl
	- cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms
	- cs_simp: V_cs_simps cat_cs_simps
	- )+
	-
	- interpret \<aa>\<bb>\<gg>\<ff>: is_cat_cone
	- \<alpha> \<open>vequalizer \<aa> \<gg> \<ff>\<close> ?II \<open>cat_Set \<alpha>\<close> ?II_II \<open>ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff>\<close>
	- by (rule \<aa>\<bb>\<gg>\<ff>_is_cat_cone)
	-
	- show "\<exists>!f'.
	- f' : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff> \<and>
	- u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) f'"
	- if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" for u' r'
	- proof-
	-
	- interpret u': is_cat_cone \<alpha> r' ?II \<open>cat_Set \<alpha>\<close> ?II_II u' by (rule that(1))
	-
	- have "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>"
	- unfolding the_cat_parallel_2_components(1) by simp
	- from
	- u'.ntcf_NTMap_is_arr[OF this]
	- \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_cf_parallel_2_cat_equalizer[OF assms]
	- have u'_\<aa>\<^sub>P\<^sub>L_is_arr: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<aa>"
	- by (cs_prems_atom_step cat_cs_simps)
	- (
	- cs_prems
	- cs_simp: cat_parallel_cs_simps
	- cs_intro:
	- cat_parallel_cs_intros
	- cat_cs_intros
	- category.cat_cf_parallel_2_cat_equalizer
	- )
	- note u'_\<aa>\<^sub>P\<^sub>L = cat_Set_is_arrD[OF u'_\<aa>\<^sub>P\<^sub>L_is_arr]
	- interpret u'_\<aa>\<^sub>P\<^sub>L: arr_Set \<alpha> \<open>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<close> by (rule u'_\<aa>\<^sub>P\<^sub>L(1))
	-
	- have "\<bb>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	-
	- from
	- u'.ntcf_NTMap_is_arr[OF this]
	- \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_cf_parallel_2_cat_equalizer[OF assms]
	- have "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_cs_simps cat_parallel_cs_simps
	- cs_intro: cat_parallel_cs_intros
	- )
	-
	- note u'_\<gg>u' = cat_cone_cf_par_2_eps_NTMap_app(1)[OF that(1) assms]
	-
	- define q where "q = [u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>, r', vequalizer \<aa> \<gg> \<ff>]\<^sub>\<circ>"
	-
	- have q_components[cat_Set_cs_simps]:
	- "q\<lparr>ArrVal\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>"
	- "q\<lparr>ArrDom\<rparr> = r'"
	- "q\<lparr>ArrCod\<rparr> = vequalizer \<aa> \<gg> \<ff>"
	- unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)
	-
	- from cat_cone_cf_par_2_eps_NTMap_app[OF that(1) assms] have \<gg>u'_eq_\<ff>u':
	- "(\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> =
	- (\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	- for x
	- by simp
	-
	- show ?thesis
	- proof(intro ex1I conjI; (elim conjE)?)
	-
	- have u'_NTMap_vrange: "\<R>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	- proof(rule vsubsetI)
	- fix y assume prems: "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>)"
	- then obtain x where x: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>)"
	- and y_def: "y = u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	- by (blast dest: u'_\<aa>\<^sub>P\<^sub>L.ArrVal.vrange_atD)
	- have x: "x \<in>\<^sub>\<circ> r'"
	- by (use x u'_\<aa>\<^sub>P\<^sub>L_is_arr in \<open>cs_prems cs_shallow cs_simp: cat_cs_simps\<close>)
	- from \<gg>u'_eq_\<ff>u'[of x] assms x u'_\<aa>\<^sub>P\<^sub>L_is_arr have [simp]:
	- "\<gg>\<lparr>ArrVal\<rparr>\<lparr>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr> =
	- \<ff>\<lparr>ArrVal\<rparr>\<lparr>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from prems u'_\<aa>\<^sub>P\<^sub>L.arr_Set_ArrVal_vrange[unfolded u'_\<aa>\<^sub>P\<^sub>L] show
	- "y \<in>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	- by (intro vequalizerI, unfold y_def) auto
	- qed
	-
	- show q_is_arr: "q : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff>"
	- proof(intro cat_Set_is_arrI arr_SetI)
	- show "q\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
	- qed
	- (
	- auto
	- simp:
	- cat_Set_cs_simps nat_omega_simps
	- u'_\<aa>\<^sub>P\<^sub>L
	- q_def
	- u'_NTMap_vrange
	- \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_in_Obj_in_Vset
	- intro: cat_cs_intros cat_lim_cs_intros
	- )
	-
	- from q_is_arr have \<aa>_q:
	- "incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q :
	- r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<aa>"
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps
	- cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	- )
	- interpret arr_Set \<alpha> \<open>incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q\<close>
	- using \<aa>_q by (auto dest: cat_Set_is_arrD)
	-
	- show "u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q"
	- proof(rule ntcf_eqI)
	- from q_is_arr show
	- "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q :
	- cf_const ?II (cat_Set \<alpha>) r' \<mapsto>\<^sub>C\<^sub>F
	- ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from q_is_arr have dom_rhs:
	- "\<D>\<^sub>\<circ>
	- (
	- (ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	- ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "u'\<lparr>NTMap\<rparr> =
	- (
	- ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- show "vsv ((
	- ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	- fix a assume prems: "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- have [symmetric, cat_Set_cs_simps]:
	- "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q"
	- proof(rule arr_Set_eqI[of \<alpha>])
	- from u'_\<aa>\<^sub>P\<^sub>L_is_arr have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>) = r'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- from \<aa>_q have dom_rhs:
	- "\<D>\<^sub>\<circ> ((incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>) = r'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- show "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr> =
	- (incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix a assume prems: "a \<in>\<^sub>\<circ> r'"
	- with u'_NTMap_vrange dom_lhs u'_\<aa>\<^sub>P\<^sub>L.ArrVal.vsv_vimageI2 have
	- "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	- by blast
	- with prems q_is_arr u'_\<aa>\<^sub>P\<^sub>L_is_arr show
	- "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	- (incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_Set_cs_simps cat_cs_simps
	- cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	- )
	- qed auto
	- qed
	- (
	- use u'_\<aa>\<^sub>P\<^sub>L \<aa>_q in \<open>
	- cs_concl cs_shallow
	- cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
	- \<close>
	- )+
	- from q_is_arr have u'_NTMap_app_I: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> =
	- (
	- ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- by
	- (
	- cs_concl
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
	- )
	- from q_is_arr assms have u'_NTMap_app_sI: "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> =
	- (
	- ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- by
	- (
	- cs_concl
	- cs_simp: cat_Set_cs_simps cat_cs_simps u'_\<gg>u'
	- cs_intro:
	- V_cs_intros
	- cat_cs_intros
	- cat_Set_cs_intros
	- cat_parallel_cs_intros
	- )
	- from prems consider \<open>a = \<aa>\<^sub>P\<^sub>L\<^sub>2\<close> \| \<open>a = \<bb>\<^sub>P\<^sub>L\<^sub>2\<close>
	- by (elim the_cat_parallel_2_ObjE)
	- then show
	- "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	- (
	- ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	- ntcf_const ?II (cat_Set \<alpha>) q
	- )\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
	- qed auto
	- qed (simp_all add: u'.is_ntcf_axioms)
	-
	- fix f' assume prems:
	- "f' : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff>"
	- "u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) f'"
	- from prems(2) have u'_NTMap_app:
	- "u'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	- (ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	- ntcf_const ?II (cat_Set \<alpha>) f')\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	- for x
	- by simp
	- have u'_f':
	- "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> f'"
	- using u'_NTMap_app[of \<aa>\<^sub>P\<^sub>L\<^sub>2] prems(1)
	- by
	- (
	- cs_prems
	- cs_simp: cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros
	- )
	-
	- note f' = cat_Set_is_arrD[OF prems(1)]
	- note q = cat_Set_is_arrD[OF q_is_arr]
	-
	- interpret f': arr_Set \<alpha> f' using prems(1) by (auto dest: cat_Set_is_arrD)
	- interpret q: arr_Set \<alpha> q using q by (auto dest: cat_Set_is_arrD)
	-
	- show "f' = q"
	- proof(rule arr_Set_eqI[of \<alpha>])
	- have dom_lhs: "\<D>\<^sub>\<circ> (f'\<lparr>ArrVal\<rparr>) = r'" by (simp add: cat_Set_cs_simps f')
	- from q_is_arr have dom_rhs: "\<D>\<^sub>\<circ> (q\<lparr>ArrVal\<rparr>) = r'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros
	- )
	- show "f'\<lparr>ArrVal\<rparr> = q\<lparr>ArrVal\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix i assume "i \<in>\<^sub>\<circ> r'"
	- with prems(1) show "f'\<lparr>ArrVal\<rparr>\<lparr>i\<rparr> = q\<lparr>ArrVal\<rparr>\<lparr>i\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_Set_cs_simps cat_cs_simps q_components u'_f'
	- cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	- )
	- qed auto
	- qed
	- (
	- use prems(1) q_is_arr in \<open>
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
	- \<close>
	- )+
	- qed
	- qed
	-
	-qed (auto intro: assms)
	-
	-
	-
	-subsection\<open>The category \<open>Set\<close> is small-complete\<close>
	-
	-lemma (in \<Z>) cat_small_complete_cat_Set: "cat_small_complete \<alpha> (cat_Set \<alpha>)"
	- \<comment>\<open>This lemma appears as a remark on page 113 in
	-\cite{mac_lane_categories_2010}.\<close>
	-proof(rule category.cat_small_complete_if_eq_and_obj_prod)
	- show "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- if "\<ff> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" and "\<gg> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" for \<aa> \<bb> \<gg> \<ff>
	- using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
	- show "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	- if "tm_cf_discrete \<alpha> I A (cat_Set \<alpha>)" for A I
	- proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
	- interpret tm_cf_discrete \<alpha> I A \<open>cat_Set \<alpha>\<close> by (rule that)
	- show "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>" by (rule tm_cf_discrete_ObjMap_in_Vset)
	- qed
	-qed (rule category_cat_Set)
	-
	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Conclusions.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Conclusions.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Conclusions.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Conclusions.thy
	@@ -1,13 +1,21 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	theory CZH_UCAT_Conclusions
	imports
	CZH_UCAT_Universal
	CZH_UCAT_Limit
	+ CZH_UCAT_Limit_IT
	+ CZH_UCAT_Limit_Product
	+ CZH_UCAT_Limit_Pullback
	+ CZH_UCAT_Limit_Equalizer
	+ CZH_UCAT_Pointed
	+ CZH_UCAT_Representable
	CZH_UCAT_Complete
	+ CZH_UCAT_Comma
	+ CZH_UCAT_Set
	CZH_UCAT_Adjoints
	CZH_UCAT_Kan
	CZH_UCAT_PWKan
	CZH_UCAT_PWKan_Example
	begin
	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
	@@ -1,3355 +1,3353 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Simple Kan extensions\<close>
	theory CZH_UCAT_Kan
	imports
	CZH_Elementary_Categories.CZH_ECAT_Comma
	- CZH_UCAT_Limit
	CZH_UCAT_Adjoints
	begin



	subsection\<open>Background\<close>

	-named_theorems ua_field_simps
	-
	-definition UObj :: V where [ua_field_simps]: "UObj = 0"
	-definition UArr :: V where [ua_field_simps]: "UArr = 1\<^sub>\<nat>"
	-
	named_theorems cat_Kan_cs_simps
	named_theorems cat_Kan_cs_intros



	subsection\<open>Kan extension\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Chapter X-3 in \cite{mac_lane_categories_2010}.\<close>

	locale is_cat_rKe =
	AG: is_functor \<alpha> \<BB> \<CC> \<KK> +
	Ran: is_functor \<alpha> \<CC> \<AA> \<GG> +
	ntcf_rKe: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon>
	for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> +
	assumes cat_rKe_ua_fo:
	"universal_arrow_fo
	(exp_cat_cf \<alpha> \<AA> \<KK>)
	(cf_map \<TT>)
	(cf_map \<GG>)
	(ntcf_arrow \<epsilon>)"

	syntax "_is_cat_rKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> [51, 51, 51, 51, 51, 51, 51] 51)
	translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons>
	"CONST is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>"

	locale is_cat_lKe =
	AG: is_functor \<alpha> \<BB> \<CC> \<KK> +
	Lan: is_functor \<alpha> \<CC> \<AA> \<FF> +
	ntcf_lKe: is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta>
	for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> +
	assumes cat_lKe_ua_fo:
	"universal_arrow_fo
	(exp_cat_cf \<alpha> (op_cat \<AA>) (op_cf \<KK>))
	(cf_map \<TT>)
	(cf_map \<FF>)
	(ntcf_arrow (op_ntcf \<eta>))"

	syntax "_is_cat_lKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> [51, 51, 51, 51, 51, 51, 51] 51)
	translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons>
	"CONST is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>"


	text\<open>Rules.\<close>

	lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "\<GG>' = \<GG>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_rKe_axioms)

	mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
	\|intro is_cat_rKeI\|
	\|dest is_cat_rKeD[dest]\|
	\|elim is_cat_rKeE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

	lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "\<FF>' = \<FF>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_lKe_axioms)

	mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
	\|intro is_cat_lKeI\|
	\|dest is_cat_lKeD[dest]\|
	\|elim is_cat_lKeE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)


	text\<open>Duality.\<close>

	lemma (in is_cat_rKe) is_cat_lKe_op:
	"op_ntcf \<epsilon> :
	op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
	by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
	(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+

	lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<GG>' = op_cf \<GG>"
	and "\<KK>' = op_cf \<KK>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf \<epsilon> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_lKe_op)

	lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'

	lemma (in is_cat_lKe) is_cat_rKe_op:
	"op_ntcf \<eta> :
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
	by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
	(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+

	lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<FF>' = op_cf \<FF>"
	and "\<KK>' = op_cf \<KK>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf \<eta> : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_rKe_op)

	lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'


	text\<open>Elementary properties.\<close>

	lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "exp_cat_cf \<alpha> \<AA> \<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	rule exp_cat_cf_is_tiny_functor[
	OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
	]
	)

	lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows "exp_cat_cf \<alpha> \<AA> \<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	rule exp_cat_cf_is_tiny_functor[
	OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
	]
	)


	subsubsection\<open>Universal property\<close>


	text\<open>
	See Chapter X-3 in \cite{mac_lane_categories_2010} and
	\cite{noauthor_wikipedia_2001}\footnote{
	\url{https://en.wikipedia.org/wiki/Kan_extension}
	}.
	\<close>

	lemma is_cat_rKeI':
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>\<GG>' \<epsilon>'.
	\<lbrakk> \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>; \<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<rbrakk> \<Longrightarrow>
	\<exists>!\<sigma>. \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<GG>: is_functor \<alpha> \<CC> \<AA> \<GG> by (rule assms(2))
	interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon> by (rule assms(3))
	let ?\<AA>\<KK> = \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
	and ?\<TT> = \<open>cf_map \<TT>\<close>
	and ?\<GG> = \<open>cf_map \<GG>\<close>
	show ?thesis
	proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<KK>.\<Z>_Limit_\<alpha>\<omega> \<KK>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<KK>.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp
	show "?\<AA>\<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
	by
	(
	cs_concl cs_shallow cs_intro:
	cat_small_cs_intros
	exp_cat_cf_is_tiny_functor[
	OF \<beta>.\<Z>_axioms \<alpha>\<beta> \<GG>.HomCod.category_axioms assms(1)
	]
	)
	from \<alpha>\<beta> assms(2) show "cf_map \<GG> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	unfolding cat_FUNCT_components
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
	from assms(1-3) show "ntcf_arrow \<epsilon> :
	?\<AA>\<KK>\<lparr>ObjMap\<rparr>\<lparr>?\<GG>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1)
	cs_intro: cat_FUNCT_cs_intros
	)
	fix \<FF>' \<epsilon>' assume prems:
	"\<FF>' \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	"\<epsilon>' : ?\<AA>\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<FF>'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
	from prems(1) have "\<FF>' \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"
	unfolding cat_FUNCT_components(1) by simp
	then obtain \<FF> where \<FF>'_def: "\<FF>' = cf_map \<FF>" and \<FF>: "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by clarsimp
	note \<epsilon>' = cat_FUNCT_is_arrD[OF prems(2)]
	from \<epsilon>'(1) \<FF> have \<epsilon>'_is_ntcf:
	"ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' : \<FF> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_prems
	cs_simp: \<FF>'_def cat_Kan_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from assms(4)[OF \<FF> \<epsilon>'_is_ntcf] obtain \<sigma>
	where \<sigma>: "\<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and \<epsilon>'_def': "ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	and unique_\<sigma>: "\<And>\<sigma>'.
	\<lbrakk>
	\<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
	ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)
	\<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
	by metis
	show "\<exists>!f'.
	f' : \<FF>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG> \<and>
	\<epsilon>' = umap_fo ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) \<FF>'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof(intro ex1I conjI; (elim conjE)?, unfold \<FF>'_def)
	from \<sigma> show "ntcf_arrow \<sigma> : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>"
	by (cs_concl cs_shallow cs_intro: cat_FUNCT_cs_intros)
	from \<alpha>\<beta> assms(1-3) \<sigma> \<epsilon>'(1) show
	"\<epsilon>' = umap_fo ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) (cf_map \<FF>)\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow \<sigma>\<rparr>"
	by (subst \<epsilon>')
	(
	cs_concl
	cs_simp:
	\<epsilon>'_def'[symmetric]
	cat_cs_simps
	cat_FUNCT_cs_simps
	cat_Kan_cs_simps
	cs_intro:
	cat_small_cs_intros
	cat_cs_intros
	cat_Kan_cs_intros
	cat_FUNCT_cs_intros
	)
	fix \<sigma>' assume prems:
	"\<sigma>' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>"
	"\<epsilon>' = umap_fo ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) (cf_map \<FF>)\<lparr>ArrVal\<rparr>\<lparr>\<sigma>'\<rparr>"
	note \<sigma>' = cat_FUNCT_is_arrD[OF prems(1)]
	from \<sigma>'(1) \<FF> have "ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	moreover from prems(2) prems(1) \<alpha>\<beta> assms(1-3) this \<epsilon>'(1) have
	"ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' =
	\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	by (subst (asm) \<epsilon>'(2))
	(
	cs_prems
	cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps
	cs_intro:
	cat_Kan_cs_intros
	cat_small_cs_intros
	cat_cs_intros
	cat_FUNCT_cs_intros
	)
	ultimately have \<sigma>_def: "\<sigma> = ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>'"
	by (rule unique_\<sigma>[symmetric])
	show "\<sigma>' = ntcf_arrow \<sigma>"
	by (subst \<sigma>'(2), use nothing in \<open>subst \<sigma>_def\<close>)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed
	qed
	qed

	lemma is_cat_lKeI':
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>\<FF>' \<eta>'.
	\<lbrakk> \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>; \<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<rbrakk> \<Longrightarrow>
	\<exists>!\<sigma>. \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<eta>' = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	shows "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<FF>: is_functor \<alpha> \<CC> \<AA> \<FF> by (rule assms(2))
	interpret \<eta>: is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta> by (rule assms(3))
	have
	"\<exists>!\<sigma>.
	\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA> \<and>
	\<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	if "\<GG>' : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	and "\<eta>' : \<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F op_cf \<TT> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	for \<GG>' \<eta>'
	proof-
	interpret \<GG>': is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<GG>' by (rule that(1))
	interpret \<eta>':
	is_ntcf \<alpha> \<open>op_cat \<BB>\<close> \<open>op_cat \<AA>\<close> \<open>\<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<KK>\<close> \<open>op_cf \<TT>\<close> \<eta>'
	by (rule that(2))
	from assms(4)[
	OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
	OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
	]
	obtain \<sigma> where \<sigma>: "\<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and op_\<eta>'_def: "op_ntcf \<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	and unique_\<sigma>':
	"\<lbrakk>
	\<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
	op_ntcf \<eta>' = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>
	\<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
	for \<sigma>'
	by metis
	interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<FF> \<open>op_cf \<GG>'\<close> \<sigma> by (rule \<sigma>)
	show ?thesis
	proof(intro ex1I conjI; (elim conjE)?)
	show "op_ntcf \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	by (rule \<sigma>.is_ntcf_op[unfolded cat_op_simps])
	from op_\<eta>'_def have "op_ntcf (op_ntcf \<eta>') = op_ntcf (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
	by simp
	from this \<sigma> assms(1-3) show \<eta>'_def:
	"\<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	fix \<sigma>' assume prems:
	"\<sigma>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	"\<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	interpret \<sigma>': is_ntcf \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<GG>' \<open>op_cf \<FF>\<close> \<sigma>'
	by (rule prems(1))
	from prems(2) have
	"op_ntcf \<eta>' = op_ntcf (op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>))"
	by simp
	also have "\<dots> = op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	finally have "op_ntcf \<eta>' = op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" by simp
	from unique_\<sigma>'[OF \<sigma>'.is_ntcf_op[unfolded cat_op_simps] this] show
	"\<sigma>' = op_ntcf \<sigma>"
	by (auto simp: cat_op_simps)
	qed
	qed
	from
	is_cat_rKeI'
	[
	OF \<KK>.is_functor_op \<FF>.is_functor_op \<eta>.is_ntcf_op[unfolded cat_op_simps],
	unfolded cat_op_simps,
	OF this
	]
	interpret \<eta>: is_cat_rKe
	\<alpha>
	\<open>op_cat \<BB>\<close>
	\<open>op_cat \<CC>\<close>
	\<open>op_cat \<AA>\<close>
	\<open>op_cf \<KK>\<close>
	\<open>op_cf \<TT>\<close>
	\<open>op_cf \<FF>\<close>
	\<open>op_ntcf \<eta>\<close>
	by simp
	show "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	by (rule \<eta>.is_cat_lKe_op[unfolded cat_op_simps])
	qed

	lemma (in is_cat_rKe) cat_rKe_unique:
	assumes "\<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<exists>!\<sigma>. \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	proof-

	interpret \<GG>': is_functor \<alpha> \<CC> \<AA> \<GG>' by (rule assms(1))
	interpret \<epsilon>': is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon>' by (rule assms(2))

	let ?\<TT> = \<open>cf_map \<TT>\<close>
	and ?\<GG> = \<open>cf_map \<GG>\<close>
	and ?\<GG>' = \<open>cf_map \<GG>'\<close>
	and ?\<epsilon> = \<open>ntcf_arrow \<epsilon>\<close>
	and ?\<epsilon>' = \<open>ntcf_arrow \<epsilon>'\<close>

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def AG.\<Z>_Limit_\<alpha>\<omega> AG.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def AG.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	interpret \<AA>\<KK>: is_tiny_functor
	\<beta> \<open>cat_FUNCT \<alpha> \<CC> \<AA>\<close> \<open>cat_FUNCT \<alpha> \<BB> \<AA>\<close> \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
	by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF \<beta>.\<Z>_axioms \<alpha>\<beta>])

	from assms(1) have \<GG>': "?\<GG>' \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros
	)
	with assms(2) have
	"?\<epsilon>' : exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>\<lparr>?\<GG>'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	from
	is_functor.universal_arrow_foD(3)[
	OF \<AA>\<KK>.is_functor_axioms cat_rKe_ua_fo \<GG>' this
	]
	obtain f' where f': "f' : cf_map \<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> cf_map \<GG>"
	and \<epsilon>'_def: "?\<epsilon>' = umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and f'_unique:
	"\<lbrakk>
	f'' : ?\<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>;
	ntcf_arrow \<epsilon>' = umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>
	\<rbrakk> \<Longrightarrow> f'' = f'"
	for f''
	by metis

	show ?thesis
	proof(intro ex1I conjI; (elim conjE)?)
	from \<epsilon>'_def cat_FUNCT_is_arrD(1)[OF f'] show
	"\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_of_ntcf_arrow \<CC> \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	by (subst (asm) cat_FUNCT_is_arrD(2)[OF f']) (slow)
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
	"ntcf_of_ntcf_arrow \<CC> \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	fix \<sigma> assume prems:
	"\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<GG>' \<GG> \<sigma> by (rule prems(1))
	from prems(1) have \<sigma>:
	"ntcf_arrow \<sigma> : cf_map \<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> cf_map \<GG>"
	by (cs_concl cs_shallow cs_intro: cat_FUNCT_cs_intros)
	from prems have \<epsilon>'_def: "ntcf_arrow \<epsilon>' =
	umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow \<sigma>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	show "\<sigma> = ntcf_of_ntcf_arrow \<CC> \<AA> f'"
	unfolding f'_unique[OF \<sigma> \<epsilon>'_def, symmetric]
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	qed

	qed

	lemma (in is_cat_lKe) cat_lKe_unique:
	assumes "\<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<exists>!\<sigma>. \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<eta>' = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	proof-

	interpret \<FF>': is_functor \<alpha> \<CC> \<AA> \<FF>' by (rule assms(1))
	interpret \<eta>': is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta>' by (rule assms(2))
	interpret \<eta>: is_cat_rKe
	\<alpha> \<open>op_cat \<BB>\<close> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<KK>\<close> \<open>op_cf \<TT>\<close> \<open>op_cf \<FF>\<close> \<open>op_ntcf \<eta>\<close>
	by (rule is_cat_rKe_op)

	from \<eta>.cat_rKe_unique[OF \<FF>'.is_functor_op \<eta>'.is_ntcf_op[unfolded cat_op_simps]]
	obtain \<sigma> where \<sigma>: "\<sigma> : op_cf \<FF>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	and \<eta>'_def: "op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	and unique_\<sigma>': "\<And>\<sigma>'.
	\<lbrakk>
	\<sigma>' : op_cf \<FF>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>;
	op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)
	\<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
	by metis

	interpret \<sigma>: is_ntcf \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<FF>'\<close> \<open>op_cf \<FF>\<close> \<sigma>
	by (rule \<sigma>)

	show ?thesis
	proof(intro ex1I conjI; (elim conjE)?)
	show "op_ntcf \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule \<sigma>.is_ntcf_op[unfolded cat_op_simps])
	have "\<eta>' = op_ntcf (op_ntcf \<eta>')"
	by (cs_concl cs_shallow cs_simp: cat_op_simps)
	also from \<eta>'_def have "\<dots> = op_ntcf (op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>))"
	by simp
	also have "\<dots> = op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	finally show "\<eta>' = op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" by simp
	fix \<sigma>' assume prems:
	"\<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<eta>' = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	interpret \<sigma>': is_ntcf \<alpha> \<CC> \<AA> \<FF> \<FF>' \<sigma>' by (rule prems(1))
	from prems(2) have "op_ntcf \<eta>' = op_ntcf (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
	by simp
	also have "\<dots> = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	finally have "op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
	by simp
	from unique_\<sigma>'[OF \<sigma>'.is_ntcf_op this] show "\<sigma>' = op_ntcf \<sigma>"
	by (auto simp: cat_op_simps)
	qed

	qed


	subsubsection\<open>Further properties\<close>

	lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	shows
	"ntcf_ua_fo \<beta> (exp_cat_cf \<alpha> \<AA> \<KK>) (cf_map \<TT>) (cf_map \<GG>) (ntcf_arrow \<epsilon>) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<CC> \<AA>(-,cf_map \<GG>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<BB> \<AA>(-,cf_map \<TT>) \<circ>\<^sub>C\<^sub>F op_cf (exp_cat_cf \<alpha> \<AA> \<KK>) :
	op_cat (cat_FUNCT \<alpha> \<CC> \<AA>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-
	interpret \<AA>_\<KK>:
	is_tiny_functor \<beta> \<open>cat_FUNCT \<alpha> \<CC> \<AA>\<close> \<open>cat_FUNCT \<alpha> \<BB> \<AA>\<close> \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
	by
	(
	rule exp_cat_cf_is_tiny_functor[
	OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
	]
	)
	show ?thesis
	by
	(
	rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
	OF \<AA>_\<KK>.is_functor_axioms cat_rKe_ua_fo
	]
	)
	qed

	lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
	assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	defines "\<AA>\<KK> \<equiv> exp_cat_cf \<alpha> (op_cat \<AA>) (op_cf \<KK>)"
	and "\<AA>\<CC> \<equiv> cat_FUNCT \<alpha> (op_cat \<CC>) (op_cat \<AA>)"
	and "\<AA>\<BB> \<equiv> cat_FUNCT \<alpha> (op_cat \<BB>) (op_cat \<AA>)"
	shows
	"ntcf_ua_fo \<beta> \<AA>\<KK> (cf_map \<TT>) (cf_map \<FF>) (ntcf_arrow (op_ntcf \<eta>)) :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>\<CC>(-,cf_map \<FF>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>\<BB>(-,cf_map \<TT>) \<circ>\<^sub>C\<^sub>F op_cf \<AA>\<KK> :
	op_cat \<AA>\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-
	note simps = \<AA>\<CC>_def \<AA>\<BB>_def \<AA>\<KK>_def
	interpret \<AA>_\<KK>: is_tiny_functor \<beta> \<AA>\<CC> \<AA>\<BB> \<AA>\<KK>
	unfolding simps
	by
	(
	rule exp_cat_cf_is_tiny_functor[
	OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
	]
	)
	show ?thesis
	unfolding simps
	by
	(
	rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
	OF \<AA>_\<KK>.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
	]
	)
	qed



	subsection\<open>Opposite universal arrow for Kan extensions\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The following definition is merely a convenience utility for
	the exposition of dual results associated with the formula for
	the right Kan extension and the pointwise right Kan extension.
	\<close>

	definition op_ua :: "(V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "op_ua lim_Obj \<KK> c =
	[
	lim_Obj c\<lparr>UObj\<rparr>,
	op_ntcf (lim_Obj c\<lparr>UArr\<rparr>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma op_ua_components:
	shows [cat_op_simps]: "op_ua lim_Obj \<KK> c\<lparr>UObj\<rparr> = lim_Obj c\<lparr>UObj\<rparr>"
	and "op_ua lim_Obj \<KK> c\<lparr>UArr\<rparr> =
	op_ntcf (lim_Obj c\<lparr>UArr\<rparr>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)"
	unfolding op_ua_def ua_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Opposite universal arrow for Kan extensions is a limit\<close>

	lemma op_ua_UArr_is_cat_limit:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "u : \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "op_ntcf u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c) :
	r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) : c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	proof-

	- note [cf_cs_simps] = is_iso_functor_is_arr_isomorphism(2,3)
	+ note [cf_cs_simps] = is_iso_functor_is_iso_arr(2,3)

	let ?op_\<KK> = \<open>\<lambda>c. op_cf_obj_comma \<KK> c\<close>
	let ?op_\<KK>c = \<open>?op_\<KK> c\<close>
	and ?op_ua_UArr = \<open>op_ntcf u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret u: is_cat_colimit \<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> r u
	by (rule assms(4))

	from \<KK>.op_cf_cf_obj_comma_proj[OF assms(3)] have
	"op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c) =
	c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F (?op_\<KK> c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c)"
	by simp
	from this assms(3) have [cat_comma_cs_simps]:
	"op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c) = c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>)"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_comma_cs_simps cf_cs_simps cat_op_simps
	cs_intro: cf_cs_intros cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	from assms(3) show "?op_ua_UArr :
	r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) : c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	by
	(
	cs_concl
	cs_simp:
	cf_cs_simps cat_cs_simps cat_comma_cs_simps cat_op_simps
	\<KK>.op_cf_cf_obj_comma_proj[symmetric]
	cs_intro:
	cat_cs_intros
	cf_cs_intros
	cat_lim_cs_intros
	cat_comma_cs_intros
	cat_op_intros
	)

	qed

	context
	fixes lim_Obj :: "V \<Rightarrow> V" and c :: V
	begin

	lemmas op_ua_UArr_is_cat_limit' = op_ua_UArr_is_cat_limit
	[
	unfolded op_ua_components(2)[symmetric],
	where u=\<open>lim_Obj c\<lparr>UArr\<rparr>\<close> and r=\<open>lim_Obj c\<lparr>UObj\<rparr>\<close> and c=c,
	folded op_ua_components(2)[where lim_Obj=lim_Obj and c=c]
	]

	end



	subsection\<open>The Kan extension\<close>


	text\<open>
	The following subsection is based on the statement and proof of
	Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition the_cf_rKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj =
	[
	(\<lambda>c\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. lim_Obj c\<lparr>UObj\<rparr>),
	(
	\<lambda>g\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f.
	f :
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub>
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<and>
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_const ((\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) f
	),
	\<KK>\<lparr>HomCod\<rparr>,
	\<TT>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"

	definition the_ntcf_rKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj =
	[
	(
	\<lambda>c\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
	lim_Obj (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>0, c, \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>
	),
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK>,
	\<TT>,
	\<TT>\<lparr>HomDom\<rparr>,
	\<TT>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"

	definition the_cf_lKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj =
	op_cf (the_cf_rKe \<alpha> (op_cf \<TT>) (op_cf \<KK>) (op_ua lim_Obj \<KK>))"

	definition the_ntcf_lKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	where "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj =
	op_ntcf (the_ntcf_rKe \<alpha> (op_cf \<TT>) (op_cf \<KK>) (op_ua lim_Obj \<KK>))"


	text\<open>Components.\<close>

	lemma the_cf_rKe_components:
	shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ObjMap\<rparr> =
	(\<lambda>c\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. lim_Obj c\<lparr>UObj\<rparr>)"
	and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr> =
	(
	\<lambda>g\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f.
	f :
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub>
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<and>
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_const ((\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) f
	)"
	and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>HomDom\<rparr> = \<KK>\<lparr>HomCod\<rparr>"
	and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>HomCod\<rparr> = \<TT>\<lparr>HomCod\<rparr>"
	unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)

	lemma the_ntcf_rKe_components:
	shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTMap\<rparr> =
	(
	\<lambda>c\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
	lim_Obj (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>0, c, \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>
	)"
	and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDom\<rparr> = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK>"
	and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTCod\<rparr> = \<TT>"
	and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDGDom\<rparr> = \<TT>\<lparr>HomDom\<rparr>"
	and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDGCod\<rparr> = \<TT>\<lparr>HomCod\<rparr>"
	unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas the_cf_rKe_components' = the_cf_rKe_components[
	where \<KK>=\<KK> and \<TT>=\<TT> and \<alpha>=\<alpha>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod
	]

	lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)

	lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
	where \<KK>=\<KK> and \<TT>=\<TT> and \<alpha>=\<alpha>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod \<TT>.cf_HomDom
	]

	lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)

	end


	subsubsection\<open>Functor: object map\<close>

	mk_VLambda the_cf_rKe_components(1)
	\|vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda the_cf_rKe_components'(1)[OF \<KK> \<TT>]
	\|vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]\|

	lemma the_cf_rKe_ObjMap_vrange:
	assumes "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UObj\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<R>\<^sub>\<circ> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	unfolding the_cf_rKe_components'[OF \<KK> \<TT>]
	by (intro vrange_VLambda_vsubset assms)

	end


	subsubsection\<open>Functor: arrow map\<close>

	mk_VLambda the_cf_rKe_components(2)
	\|vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<BB> \<CC> \<KK>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)

	mk_VLambda the_cf_rKe_components(2)[where \<alpha>=\<alpha> and \<KK>=\<KK>, unfolded \<KK>.cf_HomCod]
	\|vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]\|

	context
	fixes \<AA> \<TT> c c' g
	assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and g: "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	begin

	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemma g': "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" using g by auto

	mk_VLambda the_cf_rKe_components(2)[
	where \<alpha>=\<alpha> and \<KK>=\<KK> and \<TT>=\<TT>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod
	]
	\|app the_cf_rKe_ArrMap_app_impl'\|

	lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
	OF g', unfolded \<KK>.HomCod.cat_is_arrD[OF g]
	]

	end

	end

	lemma the_cf_rKe_ArrMap_app_impl:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	and "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<exists>!f.
	f : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and>
	u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = u' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret u: is_cat_limit \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> r u
	by (rule assms(4))
	interpret u': is_cat_limit \<alpha> \<open>c' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> r' u'
	by (rule assms(5))

	have const_r_def:
	"cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>"
	proof(rule cf_eqI)
	show const_r: "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	from assms(3) show const_r_g\<KK>:
	"cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	show
	"cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr> =
	(cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	from prems assms obtain b f
	where A_def: "A = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from assms(1,3) prems f b show
	"cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	(cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	qed
	(
	use assms(3) in
	\<open>cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
	)+
	show
	"cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr> =
	(cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	show "vsv (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms(3) show "vsv ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	fix F assume prems: "F \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	with prems obtain A B where F: "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
	by (auto intro: is_arrI)
	with assms obtain b f b' f' h'
	where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b, f]\<^sub>\<circ>"
	and B_def: "B = [0, b', f']\<^sub>\<circ>"
	and h': "h' : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
	by auto
	from prems assms(3) F g' h' f f' show
	"cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by (slow)
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
	cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	qed simp
	qed simp_all

	have \<TT>c'\<KK>: "\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>"
	proof(rule cf_eqI)
	show "\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms show " \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	show "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr> = (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	fix A assume prems: "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	from assms(3) prems obtain b f
	where A_def: "A = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from prems assms b f show
	"(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	(\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed simp

	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from assms have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)

	show "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr> = (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros
	)

	fix F assume prems: "F \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	with prems obtain A B where F: "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
	unfolding cat_comma_cs_simps by (auto intro: is_arrI)
	with assms(3) obtain b f b' f' h'
	where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b, f]\<^sub>\<circ>"
	and B_def: "B = [0, b', f']\<^sub>\<circ>"
	and h': "h' : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
	by auto
	from prems assms(3) F g' h' f f' show
	"(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by (slow)
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
	cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	)
	qed simp
	qed simp_all

	from assms(1-3) have
	"u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro is_cat_coneI)
	(
	cs_concl
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_lim_cs_intros
	cs_simp: const_r_def \<TT>c'\<KK>
	)+
	with u'.cat_lim_ua_fo show
	"\<exists>!G.
	G : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and>
	u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = u' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> G"
	by simp

	qed

	lemma the_cf_rKe_ArrMap_app:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	and "lim_Obj c\<lparr>UArr\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "lim_Obj c'\<lparr>UArr\<rparr> :
	lim_Obj c'\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
	and
	"lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
	and
	"\<lbrakk>
	f : lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>;
	lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
	\<rbrakk> \<Longrightarrow> f = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret u: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
	by (rule assms(4))
	interpret u': is_cat_limit
	\<alpha> \<open>c' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj c'\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c'\<lparr>UArr\<rparr>\<close>
	by (rule assms(5))

	from assms(3) have c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto

	note the_cf_rKe_ArrMap_app_impl' =
	the_cf_rKe_ArrMap_app_impl[OF assms]
	note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
	note the_f_is_arr = the_f[THEN conjunct1]
	and the_f_commutes = the_f[THEN conjunct2]

	from assms(3) the_f_is_arr show
	"the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros
	)
	moreover from assms(3) the_f_commutes show
	"lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros
	)
	ultimately show "f = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
	if "f : lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
	and "lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
	by (metis that the_cf_rKe_ArrMap_app_impl')

	qed

	lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	and "lim_Obj c\<lparr>UArr\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "lim_Obj c'\<lparr>UArr\<rparr> :
	lim_Obj c'\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "a = lim_Obj c\<lparr>UObj\<rparr>"
	and "b = lim_Obj c'\<lparr>UObj\<rparr>"
	shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])

	lemma lim_Obj_the_cf_rKe_commute:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "lim_Obj a\<lparr>UArr\<rparr> :
	lim_Obj a\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : a \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "lim_Obj b\<lparr>UArr\<rparr> :
	lim_Obj b\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : b \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	and "[a', b', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	shows
	"lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
	lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	note f = \<KK>.HomCod.cat_is_arrD[OF assms(5)]

	interpret lim_a: is_cat_limit
	\<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj a\<lparr>UObj\<rparr>\<close> \<open>lim_Obj a\<lparr>UArr\<rparr>\<close>
	by (rule assms(3))
	interpret lim_b: is_cat_limit
	\<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj b\<lparr>UObj\<rparr>\<close> \<open>lim_Obj b\<lparr>UArr\<rparr>\<close>
	by (rule assms(4))

	note f_app = the_cf_rKe_ArrMap_app[
	where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
	]

	from f_app(2) have lim_a_f\<KK>_NTMap_app:
	"(lim_Obj a\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	(
	lim_Obj b\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)
	)\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if \<open>A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>\<close> for A
	by simp
	show
	"lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
	lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	proof-
	from assms(5,6) have a'_def: "a' = 0"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	show
	"lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
	lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	using lim_a_f\<KK>_NTMap_app[OF assms(6)] f' assms(3-6)
	unfolding a'_def
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
	)
	qed

	qed


	subsubsection\<open>Natural transformation: natural transformation map\<close>

	mk_VLambda the_ntcf_rKe_components(1)
	\|vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	mk_VLambda the_ntcf_rKe_components'(1)[OF \<KK> \<TT>]
	\|vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]\|

	end


	subsubsection\<open>The Kan extension is a Kan extension\<close>

	lemma the_cf_rKe_is_functor:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close>
	let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
	let ?const_comma = \<open>\<lambda>a b. cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj b)\<close>
	let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj

	show ?thesis
	proof(intro is_functorI')

	show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
	show "vcard ?the_cf_rKe = 4\<^sub>\<nat>"
	unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
	show "vsv (?the_cf_rKe\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	moreover show "\<D>\<^sub>\<circ> (?the_cf_rKe\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
	moreover show "\<R>\<^sub>\<circ> (?the_cf_rKe\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	proof
	(
	intro the_cf_rKe_ObjMap_vrange;
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
	)
	fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	with assms(3)[OF this] show "?UObj c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
	qed
	ultimately have [cat_Kan_cs_intros]:
	"?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" if \<open>c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>\<close> for c
	by (metis that vsubsetE vsv.vsv_value)

	show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	using assms(2) that
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: assms(3) cat_cs_intros cat_Kan_cs_intros
	)
	then have [cat_Kan_cs_intros]: "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>\<AA>\<^esub> B"
	if "A = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
	for A B a b f
	by (simp add: that)

	show
	"?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> =
	?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	(is \<open>?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = ?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f\<close>)
	if g_is_arr: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for b c g a f
	proof-

	let ?ntcf_const_c = \<open>\<lambda>f. ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f\<close>

	note g = \<KK>.HomCod.cat_is_arrD[OF that(1)]
	and f = \<KK>.HomCod.cat_is_arrD[OF that(2)]
	note lim_a = assms(3)[OF f(2)]
	and lim_b = assms(3)[OF g(2)]
	and lim_c = assms(3)[OF g(3)]
	from that have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	interpret lim_a: is_cat_limit
	\<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj a\<close> \<open>?UArr a\<close>
	by (rule lim_a)
	interpret lim_c: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
	by (rule lim_c)

	show ?thesis
	proof
	(
	rule sym,
	rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
	)

	from assms(1,2) that lim_a lim_b lim_c show
	"?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f : ?UObj a \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)

	show
	"?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c (?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f)"
	(
	is
	\<open>
	?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf
	\<close>
	)
	proof(rule ntcf_eqI)
	from that show
	"?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
	cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj a) \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
	\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F ((g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>) :
	c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	have [cat_comma_cs_simps]:
	"?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = ?const_comma c a"
	proof(rule cf_eqI)
	from g_is_arr f_is_arr show
	"?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	)
	from g_is_arr f_is_arr show "?const_comma c a : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	)
	from g_is_arr f_is_arr have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) =
	c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
	)
	from g_is_arr f_is_arr have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (?const_comma c a\<lparr>ObjMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_cs_simps)

	show
	"(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr> =
	?const_comma c a\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	from f_is_arr g_is_arr show
	"vsv ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	)
	fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with g_is_arr obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	from prems b' f' g_is_arr f_is_arr show
	"(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
	?const_comma c a\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from g_is_arr f_is_arr have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) =
	c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
	)
	from g_is_arr f_is_arr have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (?const_comma c a\<lparr>ArrMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_cs_simps)

	show
	"(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr> =
	?const_comma c a\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	from f_is_arr g_is_arr show
	"vsv ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
	)
	fix F assume "F \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
	then obtain A B where F: "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
	unfolding cat_comma_cs_simps by (auto intro: is_arrI)
	with g_is_arr obtain b' f' b'' f'' h'
	where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b', f']\<^sub>\<circ>"
	and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'': "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
	by auto
	from F f_is_arr g_is_arr g' h' f' f'' show
	"(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	?const_comma c a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
	unfolding F_def A_def B_def
	by
	(
	cs_concl
	cs_intro:
	cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
	cs_simp:
	cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
	)
	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	qed simp_all

	from that show
	"?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf :
	cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj a) \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
	\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F ((g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>) :
	c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps
	cs_intro:
	cat_lim_cs_intros
	cat_comma_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	)
	from that have dom_lhs:
	"\<D>\<^sub>\<circ> ((?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_comma_cs_intros
	cs_simp: cat_cs_simps cat_comma_cs_simps
	)
	from that have dom_rhs:
	"\<D>\<^sub>\<circ> ((?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>) =
	c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
	cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
	)
	show
	"(?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> =
	(?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with g_is_arr obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	note \<TT>.HomCod.cat_Comp_assoc[cat_cs_simps del]
	and \<KK>.HomCod.cat_Comp_assoc[cat_cs_simps del]
	and category.cat_Comp_assoc[cat_cs_simps del]
	note [symmetric, cat_cs_simps] =
	lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
	\<KK>.HomCod.cat_Comp_assoc
	\<TT>.HomCod.cat_Comp_assoc
	from assms(1,2) that prems lim_a lim_b lim_c b' f' show
	"(?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	(?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by (very slow)
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
	cs_intro:
	cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
	)+
	- qed (cs_concl cs_shallow cs_simp: cs_intro: cat_cs_intros)+
	+ qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
	qed simp_all
	qed
	qed

	show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	proof-

	let ?ntcf_const_c = \<open>ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<AA>\<lparr>CId\<rparr>\<lparr>?UObj c\<rparr>)\<close>

	note lim_c = assms(3)[OF that]

	from that have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	interpret lim_c: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
	by (rule lim_c)

	show ?thesis
	proof
	(
	rule sym,
	rule the_cf_rKe_ArrMap_app(3)[
	where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
	]
	)
	from that lim_c show
	"\<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> : ?UObj c \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_lim_cs_intros
	)
	have "?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c"
	proof(rule ntcf_eqI)
	from lim_c that show
	"?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj c) \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
	\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
	c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
	from lim_c that show
	"?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj c) \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
	\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
	c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (very slow)
	(
	cs_concl
	cs_intro: cat_cs_intros
	cs_simp: \<KK>.cf_arr_cf_comma_CId cat_cs_simps
	cs_intro: cat_lim_cs_intros
	)
	from that have dom_lhs:
	"\<D>\<^sub>\<circ> ((?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)

	from that have dom_rhs:
	"\<D>\<^sub>\<circ> ((?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_intro: cat_lim_cs_intros cat_cs_intros
	cs_simp: cat_cs_simps
	)
	show
	"(?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> =
	(?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with that obtain b f
	where A_def: "A = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from that prems f have
	"?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> : ?UObj c \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_comma_cs_intros cat_cs_intros
	)
	from that prems f show
	"(?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	(?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	- cs_intro:
	+ cs_intro:
	cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
	)
	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ qed (cs_concl cs_intro: cat_cs_intros)
	qed simp_all

	with that show
	"?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
	?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros
	)

	qed

	qed

	qed
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma the_cf_lKe_is_functor:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	{
	fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>".
	then interpret lim_Obj_c: is_cat_colimit
	\<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
	by simp
	note op_ua_UArr_is_cat_limit'[
	where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
	]
	}
	note the_cf_rKe_is_functor = the_cf_rKe_is_functor
	[
	OF \<KK>.is_functor_op \<TT>.is_functor_op,
	unfolded cat_op_simps,
	where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>,
	unfolded cat_op_simps,
	OF this,
	simplified,
	folded the_cf_lKe_def
	]
	show "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	rule is_functor.is_functor_op
	[
	OF the_cf_rKe_is_functor,
	folded the_cf_lKe_def,
	unfolded cat_op_simps
	]
	)
	qed

	lemma the_ntcf_rKe_is_ntcf:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj :
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close>
	let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
	let ?const_comma = \<open>\<lambda>a b. cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj b)\<close>
	let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
	let ?the_ntcf_rKe = \<open>the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret cf_rKe: is_functor \<alpha> \<CC> \<AA> \<open>?the_cf_rKe\<close>
	by (rule the_cf_rKe_is_functor[OF assms, simplified])

	show ?thesis
	proof(rule is_ntcfI')
	show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
	show "vcard ?the_ntcf_rKe = 5\<^sub>\<nat>"
	unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
	show "?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	(?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	proof-
	let ?\<KK>b = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
	from that have \<KK>b: "\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	note lim_\<KK>b = assms(3)[OF \<KK>b]
	interpret lim_\<KK>b: is_cat_limit
	\<alpha> \<open>?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b\<close> \<open>?UArr ?\<KK>b\<close>
	by (rule lim_\<KK>b)
	from that lim_\<KK>b show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
	)+
	qed
	show
	"?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> (?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f
	proof-
	let ?\<KK>a = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close> and ?\<KK>b = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close> and ?\<KK>f = \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
	from that have \<KK>a: "?\<KK>a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<KK>b: "?\<KK>b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<KK>f: "?\<KK>f : ?\<KK>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	note lim_\<KK>a = assms(3)[OF \<KK>a]
	and lim_\<KK>b = assms(3)[OF \<KK>b]
	from that have z_b_\<KK>b: "[0, b, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
	from
	lim_Obj_the_cf_rKe_commute[
	OF assms(1,2) lim_\<KK>a lim_\<KK>b \<KK>f z_b_\<KK>b, symmetric
	]
	that
	have [cat_Kan_cs_simps]:
	"?UArr ?\<KK>b\<lparr>NTMap\<rparr>\<lparr>0, b, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>?\<KK>f\<rparr> =
	?UArr ?\<KK>a\<lparr>NTMap\<rparr>\<lparr>0, b, ?\<KK>f\<rparr>\<^sub>\<bullet>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	interpret lim_\<KK>a: is_cat_limit
	\<alpha> \<open>?\<KK>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>a\<close> \<open>?UArr ?\<KK>a\<close>
	by (rule lim_\<KK>a)
	interpret lim_\<KK>b: is_cat_limit
	\<alpha> \<open>?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b\<close> \<open>?UArr ?\<KK>b\<close>
	by (rule lim_\<KK>b)
	+ note lim_\<KK>a.cat_cone_Comp_commute[cat_cs_simps del]
	+ note lim_\<KK>b.cat_cone_Comp_commute[cat_cs_simps del]
	from that have
	"[[0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>]\<^sub>\<circ>, [0, b, ?\<KK>f]\<^sub>\<circ>, [0, f]\<^sub>\<circ>]\<^sub>\<circ> :
	[0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>]\<^sub>\<circ> \<mapsto>\<^bsub>(?\<KK>a) \<down>\<^sub>C\<^sub>F \<KK>\<^esub> [0, b, ?\<KK>f]\<^sub>\<circ>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from lim_\<KK>a.ntcf_Comp_commute[OF this, symmetric] that
	have [cat_Kan_cs_simps]:
	"\<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?UArr (?\<KK>a)\<lparr>NTMap\<rparr> \<lparr>0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>\<rparr>\<^sub>\<bullet> =
	?UArr ?\<KK>a\<lparr>NTMap\<rparr>\<lparr>0, b, ?\<KK>f\<rparr>\<^sub>\<bullet>"
	- by
	+ by
	(
	- cs_prems
	+ cs_prems
	cs_simp: cat_cs_simps cat_comma_cs_simps
	- cs_intro: cat_cs_intros cat_comma_cs_intros \<Z>.cat_1_is_arrI
	+ cs_intro: cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
	)
	from that show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	)
	qed
	qed
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma the_ntcf_lKe_is_ntcf:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
	\<TT> \<mapsto>\<^sub>C\<^sub>F the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	{
	fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>".
	then interpret lim_Obj_c: is_cat_colimit
	\<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
	by simp
	note op_ua_UArr_is_cat_limit'[
	where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
	]
	}
	note the_ntcf_rKe_is_ntcf = the_ntcf_rKe_is_ntcf
	[
	OF \<KK>.is_functor_op \<TT>.is_functor_op,
	unfolded cat_op_simps,
	where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>,
	unfolded cat_op_simps,
	OF this,
	simplified
	]
	show "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
	\<TT> \<mapsto>\<^sub>C\<^sub>F the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	rule is_ntcf.is_ntcf_op
	[
	OF the_ntcf_rKe_is_ntcf,
	unfolded cat_op_simps,
	folded the_cf_lKe_def the_ntcf_lKe_def
	]
	)
	qed

	lemma the_ntcf_rKe_is_cat_rKe:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj :
	the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-

	let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close>
	let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
	let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
	let ?the_ntcf_rKe = \<open>the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret cf_rKe: is_functor \<alpha> \<CC> \<AA> ?the_cf_rKe
	by (rule the_cf_rKe_is_functor[OF assms, simplified])
	interpret ntcf_rKe: is_ntcf \<alpha> \<BB> \<AA> \<open>?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> ?the_ntcf_rKe
	by (intro the_ntcf_rKe_is_ntcf assms(3))
	(cs_concl cs_shallow cs_intro: cat_cs_intros)+

	show ?thesis
	proof(rule is_cat_rKeI')

	fix \<GG> \<epsilon> assume prems:
	"\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"

	interpret \<GG>: is_functor \<alpha> \<CC> \<AA> \<GG> by (rule prems(1))
	interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon> by (rule prems(2))

	define \<epsilon>' where "\<epsilon>' c =
	[
	(\<lambda>A\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<epsilon>\<lparr>NTMap\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>A\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>),
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>),
	\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
	c \<down>\<^sub>C\<^sub>F \<KK>,
	\<AA>
	]\<^sub>\<circ>"
	for c

	have \<epsilon>'_components:
	"\<epsilon>' c\<lparr>NTMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<epsilon>\<lparr>NTMap\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>A\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>)"
	"\<epsilon>' c\<lparr>NTDom\<rparr> = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)"
	"\<epsilon>' c\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	"\<epsilon>' c\<lparr>NTDGDom\<rparr> = c \<down>\<^sub>C\<^sub>F \<KK>"
	"\<epsilon>' c\<lparr>NTDGCod\<rparr> = \<AA>"
	for c
	unfolding \<epsilon>'_def nt_field_simps by (simp_all add: nat_omega_simps)
	note [cat_Kan_cs_simps] = \<epsilon>'_components(2-5)
	have [cat_Kan_cs_simps]: "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A a b c f
	using that unfolding \<epsilon>'_components by (auto simp: nat_omega_simps)

	have \<epsilon>': "\<epsilon>' c : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and \<epsilon>'_unique: "\<exists>!f'.
	f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f'"
	if c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	proof-
	from that have "?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = ?UObj c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros
	)
	interpret lim_c: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
	by (rule assms(3)[OF that])
	show "\<epsilon>' c : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_cat_coneI is_ntcfI')
	show "vfsequence (\<epsilon>' c)" unfolding \<epsilon>'_def by simp
	show "vcard (\<epsilon>' c) = 5\<^sub>\<nat>" unfolding \<epsilon>'_def by (simp add: nat_omega_simps)
	show "vsv (\<epsilon>' c\<lparr>NTMap\<rparr>)" unfolding \<epsilon>'_components by simp
	show "\<D>\<^sub>\<circ> (\<epsilon>' c\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" unfolding \<epsilon>'_components by simp
	show "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub>
	(\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	if "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A
	proof-
	from that prems c obtain b f
	where A_def: "A = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from that prems f c that b f show ?thesis
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	show
	"\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
	proof-
	from that c
	obtain b f b' f' k
	where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b, f]\<^sub>\<circ>"
	and B_def: "B = [0, b', f']\<^sub>\<circ>"
	and k: "k : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
	by auto
	from c that k f f' show ?thesis
	unfolding F_def A_def B_def
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_comma_cs_simps
	cat_Kan_cs_simps
	\<epsilon>.ntcf_Comp_commute''
	f'_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	qed
	(
	use c that in
	\<open>cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros\<close>
	)+
	from is_cat_limit.cat_lim_ua_fo[OF assms(3)[OF that] this] show
	"\<exists>!f'.
	f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f'"
	by simp
	qed

	define \<sigma> :: V where
	"\<sigma> =
	[
	(
	\<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f.
	f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
	),
	\<GG>,
	?the_cf_rKe,
	\<CC>,
	\<AA>
	]\<^sub>\<circ>"

	have \<sigma>_components:
	"\<sigma>\<lparr>NTMap\<rparr> =
	(
	\<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f.
	f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
	)"
	"\<sigma>\<lparr>NTDom\<rparr> = \<GG>"
	"\<sigma>\<lparr>NTCod\<rparr> = ?the_cf_rKe"
	"\<sigma>\<lparr>NTDGDom\<rparr> = \<CC>"
	"\<sigma>\<lparr>NTDGCod\<rparr> = \<AA>"
	unfolding \<sigma>_def nt_field_simps by (simp_all add: nat_omega_simps)

	note [cat_Kan_cs_simps] = \<sigma>_components(2-5)

	have \<sigma>_NTMap_app_def: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	(
	THE f.
	f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
	)"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	using that unfolding \<sigma>_components by simp

	have \<sigma>_NTMap_app_is_arr: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	and \<epsilon>'_\<sigma>_commute:
	"\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	and \<sigma>_NTMap_app_unique:
	"\<lbrakk>
	f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c;
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
	\<rbrakk> \<Longrightarrow> f = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	if c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c f
	proof-
	have
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
	\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps \<sigma>_NTMap_app_def
	cs_intro: theI' \<epsilon>'_unique that
	)
	then show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	and "\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
	by simp_all
	with c \<epsilon>'_unique[OF c] show "f = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	if "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	and "\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
	using that by metis
	qed

	have \<sigma>_NTMap_app_is_arr'[cat_Kan_cs_intros]: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : a \<mapsto>\<^bsub>\<AA>'\<^esub> b"
	if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	and "b = ?UObj c"
	and "\<AA>' = \<AA>"
	for \<AA>' a b c
	by (simp add: that \<sigma>_NTMap_app_is_arr)

	have \<epsilon>'_NTMap_app_def:
	"\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	(?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>))\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for A c
	using \<epsilon>'_\<sigma>_commute[OF that(2)] by simp
	have \<epsilon>b_\<GG>f:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	?UArr c\<lparr>NTMap\<rparr>\<lparr>a, b, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	if "A = [a, b, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	for A a b c f
	proof-
	interpret lim_c: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
	by (rule assms(3)[OF that(3)])
	from that have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by blast+
	show
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	?UArr c\<lparr>NTMap\<rparr>\<lparr>a, b, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	using \<epsilon>'_NTMap_app_def[OF that(2,3)] that(2,3)
	unfolding that(1)
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)
	qed

	show "\<exists>!\<sigma>.
	\<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and>
	\<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	proof(intro ex1I[where a=\<sigma>] conjI; (elim conjE)?)

	define \<tau> where "\<tau> a b f =
	[
	(
	\<lambda>F\<in>\<^sub>\<circ>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>.
	?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
	),
	cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>),
	\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
	b \<down>\<^sub>C\<^sub>F \<KK>,
	\<AA>
	]\<^sub>\<circ>"
	for a b f

	have \<tau>_components:
	"\<tau> a b f\<lparr>NTMap\<rparr> =
	(
	\<lambda>F\<in>\<^sub>\<circ>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>.
	?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
	)"
	"\<tau> a b f\<lparr>NTDom\<rparr> = cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	"\<tau> a b f\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	"\<tau> a b f\<lparr>NTDGDom\<rparr> = b \<down>\<^sub>C\<^sub>F \<KK>"
	"\<tau> a b f\<lparr>NTDGCod\<rparr> = \<AA>"
	for a b f
	unfolding \<tau>_def nt_field_simps by (simp_all add: nat_omega_simps)
	note [cat_Kan_cs_simps] = \<tau>_components(2-5)
	have \<tau>_NTMap_app[cat_Kan_cs_simps]:
	"\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>F\<rparr> =
	?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for a b f F
	using that unfolding \<tau>_components by auto

	have \<tau>: "\<tau> a b f :
	\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : b \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	if f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	proof-

	note f = \<KK>.HomCod.cat_is_arrD[OF that]
	note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

	interpret lim_b: is_cat_limit
	\<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj b\<close> \<open>?UArr b\<close>
	by (rule lim_b)
	-
	+
	+ note lim_b.cat_cone_Comp_commute[cat_cs_simps del]
	+
	from f have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto

	show ?thesis
	proof(intro is_cat_coneI is_ntcfI')

	show "vfsequence (\<tau> a b f)" unfolding \<tau>_def by simp
	show "vcard (\<tau> a b f) = 5\<^sub>\<nat>"
	unfolding \<tau>_def by (simp add: nat_omega_simps)
	show "vsv (\<tau> a b f\<lparr>NTMap\<rparr>)" unfolding \<tau>_components by auto
	show "\<D>\<^sub>\<circ> (\<tau> a b f\<lparr>NTMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" by (auto simp: \<tau>_components)
	show "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> :
	cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub>
	(\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	if "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A
	proof-
	from that f_is_arr obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	from f_is_arr that b' f' a b show ?thesis
	unfolding A_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
	)
	qed
	show
	"\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
	proof-
	from that have F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
	by (auto intro: is_arrI)
	with f_is_arr obtain b' f' b'' f'' h'
	where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, b', f']\<^sub>\<circ>"
	and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'': "f'' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
	by auto
	from
	lim_b.ntcf_Comp_commute[OF that]
	that f_is_arr g' h' f' f''
	have [cat_Kan_cs_simps]:
	"?UArr b\<lparr>NTMap\<rparr>\<lparr>0, b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> =
	\<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?UArr b\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet>"
	unfolding F_def A_def B_def
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp:
	cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from f_is_arr that g' h' f' f'' show ?thesis
	unfolding F_def A_def B_def (very slow)
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_comma_cs_simps
	f''_def[symmetric]
	cs_intro:
	cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
	)+
	qed

	qed
	(
	use that f_is_arr in
	\<open>
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	\<close>
	)+
	qed

	show \<sigma>: "\<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(rule is_ntcfI')

	show "vfsequence \<sigma>" unfolding \<sigma>_def by simp
	show "vcard \<sigma> = 5\<^sub>\<nat>" unfolding \<sigma>_def by (simp add: nat_omega_simps)
	show "vsv (\<sigma>\<lparr>NTMap\<rparr>)" unfolding \<sigma>_components by auto
	show "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>" unfolding \<sigma>_components by simp
	show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	using that
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)

	then have [cat_Kan_cs_intros]: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
	if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "c = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	for a b c
	using that(1) unfolding that(2,3) by simp

	show
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	proof-

	note f = \<KK>.HomCod.cat_is_arrD[OF that]
	note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

	interpret lim_a: is_cat_limit
	\<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj a\<close> \<open>?UArr a\<close>
	by (rule lim_a)
	interpret lim_b: is_cat_limit
	\<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj b\<close> \<open>?UArr b\<close>
	by (rule lim_b)

	from f have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto

	from lim_b.cat_lim_unique_cone'[OF \<tau>[OF that]] obtain g'
	where g': "g' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b"
	and \<tau>_NTMap_app: "\<And>A. A \<in>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>) \<Longrightarrow>
	\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g'"
	and g'_unique: "\<And>g''.
	\<lbrakk>
	g'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b;
	\<And>A. A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g''
	\<rbrakk> \<Longrightarrow> g'' = g'"
	by metis

	have lim_Obj_a_f\<KK>[symmetric, cat_Kan_cs_simps]:
	"?UArr a\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
	?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A a' b' f'
	proof-
	from that(2) f_is_arr have a'_def: "a' = 0"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	unfolding that(1) by auto
	show ?thesis
	unfolding that(1)
	by
	(
	rule
	lim_Obj_the_cf_rKe_commute
	[
	where lim_Obj=lim_Obj,
	OF
	assms(1,2)
	lim_a
	lim_b
	f_is_arr
	that(2)[unfolded that(1)]
	]
	)
	qed
	{
	fix a' b' f' A
	note \<TT>.HomCod.cat_assoc_helper[
	where h=\<open>?UArr b\<lparr>NTMap\<rparr>\<lparr>a',b',f'\<rparr>\<^sub>\<bullet>\<close>
	and g=\<open>?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
	and q=\<open>?UArr a\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet>\<close>
	]
	}
	note [cat_Kan_cs_simps] = this

	show ?thesis
	proof(rule trans_sym[where s=g'])
	show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = g'"
	proof(rule g'_unique)
	from that show
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b"
	by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
	fix A assume prems': "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with f_is_arr obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	from f_is_arr prems' show
	"\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)
	qed
	show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = g'"
	proof(rule g'_unique)
	fix A assume prems': "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with f_is_arr obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	{
	fix a' b' f' A
	note \<TT>.HomCod.cat_assoc_helper
	[
	where h=\<open>?UArr b\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>\<close>
	and g=\<open>\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<close>
	and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<close>
	]
	}
	note [cat_Kan_cs_simps] =
	this
	\<epsilon>b_\<GG>f[OF A_def prems' b, symmetric]
	\<epsilon>b_\<GG>f[symmetric]
	from f_is_arr prems' b' f' show
	"\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	(?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
	unfolding A_def
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_comma_cs_simps
	cat_op_simps
	cs_intro:
	cat_cs_intros
	cat_Kan_cs_intros
	cat_comma_cs_intros
	cat_op_intros
	)
	qed
	(
	use that in
	\<open>
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	\<close>
	)
	qed
	qed
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros
	)+
	then interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<GG> \<open>?the_cf_rKe\<close> \<sigma> by simp

	show "\<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	proof(rule ntcf_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (\<epsilon>\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> ((?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<epsilon>\<lparr>NTMap\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix b assume prems': "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	note [cat_Kan_cs_simps] = \<epsilon>b_\<GG>f[
	where f=\<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close> and c=\<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>, symmetric
	]
	from prems' \<sigma> show
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
	)
	qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

	fix \<sigma>' assume prems':
	"\<sigma>' : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"

	interpret \<sigma>': is_ntcf \<alpha> \<CC> \<AA> \<GG> \<open>?the_cf_rKe\<close> \<sigma>' by (rule prems'(1))

	have \<epsilon>_NTMap_app[symmetric, cat_Kan_cs_simps]:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> =
	?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	\<sigma>'\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>"
	if "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "a' = 0" for a' b'
	proof-
	from prems'(2) have \<epsilon>_NTMap_app:
	"\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
	for b'
	by simp
	show ?thesis
	using \<epsilon>_NTMap_app[of b'] that(1)
	unfolding that(2)
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed
	{
	fix a' b' f' A
	note \<TT>.HomCod.cat_assoc_helper
	[
	where h= \<open>?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>\<close>
	and g=\<open>\<sigma>'\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
	and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
	]
	}
	note [cat_Kan_cs_simps] = this \<epsilon>b_\<GG>f[symmetric]
	{
	fix a' b' f' A
	note \<TT>.HomCod.cat_assoc_helper
	[
	where h=
	\<open>?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>\<close>
	and g=\<open>\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
	and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
	]
	}
	note [cat_Kan_cs_simps] = this

	show "\<sigma>' = \<sigma>"
	proof(rule ntcf_eqI)

	show "\<sigma>' : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" by (rule prems'(1))
	show "\<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" by (rule \<sigma>)

	have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (\<sigma>'\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show "\<sigma>'\<lparr>NTMap\<rparr> = \<sigma>\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

	fix c assume prems': "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"

	note lim_c = assms(3)[OF prems']
	interpret lim_c: is_cat_limit
	\<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
	by (rule lim_c)
	from prems' have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from lim_c.cat_lim_unique_cone'[OF \<tau>[OF CId_c]] obtain f
	where f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
	and "\<And>A. A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f"
	and f_unique: "\<And>f'.
	\<lbrakk>
	f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c;
	\<And>A. A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f'
	\<rbrakk> \<Longrightarrow> f' = f"
	by metis

	note [symmetric, cat_cs_simps] =
	\<sigma>.ntcf_Comp_commute
	\<sigma>'.ntcf_Comp_commute

	show "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	proof(rule trans_sym[where s=f])

	show "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = f"
	proof(rule f_unique)

	fix A assume prems'': "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"

	with prems' obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto

	let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>

	from b' have \<KK>b': "?\<KK>b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	interpret lim_\<KK>b': is_cat_limit
	\<alpha> \<open>?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b'\<close> \<open>?UArr ?\<KK>b'\<close>
	by (rule assms(3)[OF \<KK>b'])

	from \<KK>b' have CId_\<KK>b': "\<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr> : ?\<KK>b' \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
	by (cs_concl cs_intro: cat_cs_intros)
	from CId_\<KK>b' b' have a'_b'_CId_\<KK>b':
	"[0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from
	lim_Obj_the_cf_rKe_commute[
	where lim_Obj=lim_Obj,
	OF assms(1,2) lim_c assms(3)[OF \<KK>b'] f' a'_b'_CId_\<KK>b'
	]
	f'
	have [cat_Kan_cs_simps]:
	"?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet> =
	?UArr ?\<KK>b'\<lparr>NTMap\<rparr>\<lparr>0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps)

	from prems' prems'' b' f' show
	"\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	unfolding A_def (very slow)
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro:
	cat_lim_cs_intros
	cat_cs_intros
	cat_comma_cs_intros
	cat_Kan_cs_intros
	)
	qed
	(
	use prems' in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros
	\<close>
	)

	show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = f"
	proof(rule f_unique)
	fix A assume prems'': "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	from this prems' obtain b' f'
	where A_def: "A = [0, b', f']\<^sub>\<circ>"
	and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by auto
	let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
	from b' have \<KK>b': "?\<KK>b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	interpret lim_\<KK>b': is_cat_limit
	\<alpha> \<open>?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b'\<close> \<open>?UArr ?\<KK>b'\<close>
	by (rule assms(3)[OF \<KK>b'])
	from \<KK>b' have CId_\<KK>b': "\<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr> : ?\<KK>b' \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
	by (cs_concl cs_intro: cat_cs_intros)
	from CId_\<KK>b' b' have a'_b'_CId_\<KK>b':
	"[0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)

	from
	lim_Obj_the_cf_rKe_commute
	[
	where lim_Obj=lim_Obj,
	OF assms(1,2) lim_c assms(3)[OF \<KK>b'] f' a'_b'_CId_\<KK>b'
	]
	f'
	have [cat_Kan_cs_simps]:
	"?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet> =
	?UArr (?\<KK>b')\<lparr>NTMap\<rparr>\<lparr>0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
	?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	from prems' prems'' b' f' show
	"\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	unfolding A_def (very slow)
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
	cs_intro:
	cat_lim_cs_intros
	cat_cs_intros
	cat_comma_cs_intros
	cat_Kan_cs_intros
	)
	qed
	(
	use prems' in
	\<open>
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros
	\<close>
	)
	qed

	qed auto

	qed simp_all

	qed

	qed (cs_concl cs_shallow cs_intro: cat_cs_intros)+

	qed

	lemma the_ntcf_lKe_is_cat_lKe:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
	\<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	{
	fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>".
	then interpret lim_Obj_c: is_cat_colimit
	\<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
	by simp
	note op_ua_UArr_is_cat_limit'[
	where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
	]
	}
	note the_ntcf_rKe_is_cat_rKe = the_ntcf_rKe_is_cat_rKe
	[
	OF \<KK>.is_functor_op \<TT>.is_functor_op,
	unfolded cat_op_simps,
	where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>,
	unfolded cat_op_simps,
	OF this,
	simplified,
	folded the_cf_lKe_def the_ntcf_lKe_def
	]
	show ?thesis
	by
	(
	rule is_cat_rKe.is_cat_lKe_op
	[
	OF the_ntcf_rKe_is_cat_rKe,
	unfolded cat_op_simps,
	folded the_cf_lKe_def the_ntcf_lKe_def
	]
	)
	qed



	subsection\<open>Preservation of Kan extensions\<close>


	text\<open>
	The following definitions are similar to the definitions that can be
	found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
	\<close>

	locale is_cat_rKe_preserves =
	is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> + is_functor \<alpha> \<AA> \<DD> \<HH>
	for \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<GG> \<HH> \<epsilon> +
	assumes cat_rKe_preserves:
	"\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> : (\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<HH> \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"

	syntax "_is_cat_rKe_preserves" ::
	"V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(
	\<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _ : _ \<mapsto>\<mapsto>\<^sub>C _)\<close>
	[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
	)
	translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C \<DD>)" \<rightleftharpoons>
	"CONST is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<GG> \<HH> \<epsilon>"

	locale is_cat_lKe_preserves =
	is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> + is_functor \<alpha> \<AA> \<DD> \<HH>
	for \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<FF> \<HH> \<eta> +
	assumes cat_lKe_preserves:
	"\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> : \<HH> \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> (\<HH> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"

	syntax "_is_cat_lKe_preserves" ::
	"V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(
	\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _ : _ \<mapsto>\<mapsto>\<^sub>C _)\<close>
	[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
	)
	translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C \<DD>)" \<rightleftharpoons>
	"CONST is_cat_lKe_preserves \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<FF> \<HH> \<eta>"


	text\<open>Rules.\<close>

	lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
	assumes "\<alpha>' = \<alpha>"
	and "\<GG>' = \<GG>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<HH>' = \<HH>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	and "\<DD>' = \<DD>"
	shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
	unfolding assms by (rule is_cat_rKe_preserves_axioms)

	mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
	\|intro is_cat_rKe_preservesI\|
	\|dest is_cat_rKe_preservesD[dest]\|
	\|elim is_cat_rKe_preservesE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

	lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
	assumes "\<alpha>' = \<alpha>"
	and "\<FF>' = \<FF>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<HH>' = \<HH>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	and "\<DD>' = \<DD>"
	shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
	unfolding assms by (rule is_cat_lKe_preserves_axioms)

	mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
	\|intro is_cat_lKe_preservesI\|
	\|dest is_cat_lKe_preservesD[dest]\|
	\|elim is_cat_lKe_preservesE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)


	text\<open>Duality.\<close>

	lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
	"op_ntcf \<epsilon> :
	op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (op_cf \<HH> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C op_cat \<DD>)"
	proof(intro is_cat_lKe_preservesI)
	from cat_rKe_preserves show "op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<epsilon> :
	op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> (op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<DD>"
	by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
	(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	qed (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+

	lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<GG>' = op_cf \<GG>"
	and "\<KK>' = op_cf \<KK>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	and "\<DD>' = op_cat \<DD>"
	and "\<HH>' = op_cf \<HH>"
	shows "op_ntcf \<epsilon> :
	\<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
	unfolding assms by (rule is_cat_rKe_preserves_op)

	lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'

	lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
	"op_ntcf \<eta> :
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (op_cf \<HH> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C op_cat \<DD>)"
	proof(intro is_cat_rKe_preservesI)
	from cat_lKe_preserves show "op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<eta> :
	(op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<DD>"
	by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
	(cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	qed (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+

	lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<FF>' = op_cf \<FF>"
	and "\<KK>' = op_cf \<KK>"
	and "\<HH>' = op_cf \<HH>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	and "\<DD>' = op_cat \<DD>"
	shows "op_ntcf \<eta> :
	\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
	unfolding assms by (rule is_cat_rKe_preserves_op)



	subsection\<open>All concepts are Kan extensions\<close>


	text\<open>
	Background information for this subsection is provided in
	Chapter X-7 in \cite{mac_lane_categories_2010}
	-and section 6.5 in \cite{riehl_category_2016}.
	+and subsection 6.5 in \cite{riehl_category_2016}.
	It should be noted that only the connections between the Kan extensions,
	limits and adjunctions are exposed (an alternative proof of the Yoneda
	lemma using Kan extensions is not provided in the context of this work).
	\<close>


	subsubsection\<open>Limits and colimits\<close>

	lemma cat_rKe_is_cat_limit:
	\<comment>\<open>The statement of the theorem is similar to the statement of a part of
	Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010}
	or Proposition 6.5.1 in \cite{riehl_category_2016}.\<close>
	assumes "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	interpret \<epsilon>: is_cat_rKe \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<KK> \<TT> \<GG> \<epsilon> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<epsilon>.AG.HomCod.cat_in_Obj_in_Vset)
	from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<epsilon>.AG.HomCod.cat_in_Arr_in_Vset)

	have \<KK>_def: "\<KK> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>"
	by (rule cf_const_if_HomCod_is_cat_1)
	(cs_concl cs_shallow cs_intro: cat_cs_intros)
	have \<GG>\<KK>_def: "\<GG> \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_1_components(1) \<KK>_def cat_cs_simps
	cs_intro: V_cs_intros cat_cs_intros
	)

	interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon>
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	show "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_cat_limitI is_cat_coneI)

	show "\<epsilon> : cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule \<epsilon>.ntcf_rKe.is_ntcf_axioms[unfolded \<GG>\<KK>_def])

	fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"

	interpret u': is_cat_cone \<alpha> r' \<BB> \<AA> \<TT> u' by (rule prems)

	have \<GG>_def: "\<GG> = cf_const (cat_1 \<aa> \<ff>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
	by (rule cf_const_if_HomDom_is_cat_1[OF \<epsilon>.Ran.is_functor_axioms])

	from prems have const_r': "cf_const (cat_1 \<aa> \<ff>) \<AA> r' : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
	)

	have cf_comp_cf_const_r_\<KK>_def:
	"cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> r'"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps \<KK>_def
	cs_intro: cat_cs_intros cat_lim_cs_intros
	)

	from \<epsilon>.cat_rKe_unique[
	OF const_r', unfolded cf_comp_cf_const_r_\<KK>_def, OF u'.is_ntcf_axioms
	]
	obtain \<sigma>
	where \<sigma>: "\<sigma> : cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and u'_def: "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	and unique_\<sigma>: "\<And>\<sigma>'.
	\<lbrakk>
	\<sigma>' : cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
	u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)
	\<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
	by auto

	interpret \<sigma>: is_ntcf \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<open>cf_const (cat_1 \<aa> \<ff>) \<AA> r'\<close> \<GG> \<sigma>
	by (rule \<sigma>)

	show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<and> u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
	proof(intro ex1I conjI; (elim conjE)?)
	fix f' assume prems':
	"f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>" "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
	from prems'(1) have "ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' :
	cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (subst \<GG>_def)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	moreover with prems'(1) have "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps prems'(2) \<KK>_def cs_intro: cat_cs_intros
	)
	ultimately have \<sigma>_def: "\<sigma> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'"
	by (auto simp: unique_\<sigma>[symmetric])
	show "f' = \<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps \<sigma>_def cs_intro: cat_cs_intros)
	qed (cs_concl cs_simp: cat_cs_simps u'_def \<KK>_def cs_intro: cat_cs_intros)+

	qed (cs_concl cs_simp: \<KK>_def cs_intro: cat_cs_intros)

	qed

	lemma cat_lKe_is_cat_colimit:
	assumes "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<eta> : \<TT> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret \<eta>: is_cat_lKe \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<KK> \<TT> \<FF> \<eta> by (rule assms(1))
	from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<eta>.AG.HomCod.cat_in_Obj_in_Vset)
	from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<eta>.AG.HomCod.cat_in_Arr_in_Vset)
	show ?thesis
	by
	(
	rule is_cat_limit.is_cat_colimit_op
	[
	OF cat_rKe_is_cat_limit[
	OF
	\<eta>.is_cat_rKe_op[unfolded \<eta>.AG.cat_1_op[OF \<aa> \<ff>]]
	\<eta>.ntcf_lKe.NTDom.is_functor_op
	],
	unfolded cat_op_simps
	]
	)
	qed

	lemma cat_limit_is_rKe:
	\<comment>\<open>The statement of the theorem is similar to the statement of a part of
	Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010}
	or Proposition 6.5.1 in \cite{riehl_category_2016}.\<close>
	assumes "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
	and "\<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
	proof-

	interpret \<epsilon>: is_cat_limit \<alpha> \<BB> \<AA> \<TT> \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>\<close> \<epsilon> by (rule assms)
	interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(2))
	interpret \<GG>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG> by (rule assms(3))

	show ?thesis
	proof(rule is_cat_rKeI')

	note \<KK>_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
	note \<GG>_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]

	have \<GG>\<KK>_def: "\<GG> \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
	by (subst \<KK>_def, use nothing in \<open>subst \<GG>_def\<close>)
	(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	show "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps \<GG>\<KK>_def cs_intro: cat_cs_intros
	)

	fix \<GG>' \<epsilon>' assume prems:
	"\<GG>' : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"

	interpret is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG>' by (rule prems(1))

	note \<GG>'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]

	from prems(2) have \<epsilon>':
	"\<epsilon>' : cf_const \<BB> \<AA> (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	unfolding \<KK>_def
	by (subst (asm) \<GG>'_def)
	(cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from prems(2) have "\<epsilon>' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro is_cat_coneI \<epsilon>') (cs_concl cs_intro: cat_cs_intros)+

	from \<epsilon>.cat_lim_ua_fo[OF this] obtain f'
	where f': "f' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>"
	and \<epsilon>_def: "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
	and unique_f':
	"\<lbrakk>
	f'' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>;
	\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f''
	\<rbrakk> \<Longrightarrow> f'' = f'"
	for f''
	by metis

	show "\<exists>!\<sigma>.
	\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	proof(intro ex1I conjI; (elim conjE)?)
	from f' show
	"ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (subst \<GG>'_def, use nothing in \<open>subst \<GG>_def\<close>)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	with f' show "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	by (cs_concl cs_simp: cat_cs_simps \<epsilon>_def \<KK>_def cs_intro: cat_cs_intros)
	fix \<sigma> assume prems:
	"\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
	interpret \<sigma>: is_ntcf \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG>' \<GG> \<sigma> by (rule prems(1))
	have "\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr> : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	moreover have "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps prems(2) \<KK>_def cs_intro: cat_cs_intros
	)
	ultimately have \<sigma>\<aa>: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr> = f'" by (rule unique_f')
	show "\<sigma> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'"
	proof(rule ntcf_eqI)
	from f' show
	"ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (subst \<GG>'_def, use nothing in \<open>subst \<GG>_def\<close>)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
	have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>) = cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
	show "\<sigma>\<lparr>NTMap\<rparr> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
	then have a_def: "a = \<aa>" unfolding cat_1_components by simp
	from f' show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	unfolding a_def \<sigma>\<aa>
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed (auto intro: cat_cs_intros)
	qed (simp_all add: prems)
	qed

	qed (auto simp: assms)

	qed

	lemma cat_colimit_is_lKe:
	assumes "\<eta> : \<TT> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
	and "\<FF> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<eta>: is_cat_colimit \<alpha> \<BB> \<AA> \<TT> \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>\<close> \<eta>
	by (rule assms(1))
	interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(2))
	interpret \<FF>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<FF> by (rule assms(3))
	from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<KK>.HomCod.cat_in_Obj_in_Vset)
	from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (auto simp: \<KK>.HomCod.cat_in_Arr_in_Vset)
	have \<FF>\<aa>: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> = op_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>" unfolding cat_op_simps by simp
	note cat_1_op = \<eta>.cat_1_op[OF \<aa> \<ff>]
	show ?thesis
	by
	(
	rule is_cat_rKe.is_cat_lKe_op
	[
	OF cat_limit_is_rKe
	[
	OF
	\<eta>.is_cat_limit_op[unfolded \<FF>\<aa>]
	\<KK>.is_functor_op[unfolded cat_1_op]
	\<FF>.is_functor_op[unfolded cat_1_op]
	],
	unfolded cat_op_simps cat_1_op
	]
	)
	qed


	subsubsection\<open>Adjoints\<close>

	lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
	\<comment>\<open>The statement of the theorem is similar to the statement of a part of
	Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
	or Proposition 6.5.2 in \cite{riehl_category_2016}.
	The proof follows (approximately) the proof in \cite{riehl_category_2016}.\<close>
	shows "\<epsilon>\<^sub>C \<Phi> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> cf_id \<DD> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"
	proof-

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF \<beta> \<alpha>\<beta> R.category_axioms]

	let ?\<eta> = \<open>\<eta>\<^sub>C \<Phi>\<close>
	let ?\<epsilon> = \<open>\<epsilon>\<^sub>C \<Phi>\<close>
	let ?\<DD>\<eta> = \<open>exp_cat_ntcf \<alpha> \<DD> ?\<eta>\<close>
	let ?\<DD>\<FF> = \<open>exp_cat_cf \<alpha> \<DD> \<FF>\<close>
	let ?\<DD>\<GG> = \<open>exp_cat_cf \<alpha> \<DD> \<GG>\<close>
	let ?\<DD>\<DD> = \<open>cat_FUNCT \<alpha> \<DD> \<DD>\<close>
	let ?\<CC>\<DD> = \<open>cat_FUNCT \<alpha> \<CC> \<DD>\<close>
	let ?adj_\<DD>\<eta> = \<open>cf_adjunction_of_unit \<beta> ?\<DD>\<GG> ?\<DD>\<FF> ?\<DD>\<eta>\<close>

	interpret \<DD>\<eta>: is_cf_adjunction \<beta> ?\<CC>\<DD> ?\<DD>\<DD> ?\<DD>\<GG> ?\<DD>\<FF> ?adj_\<DD>\<eta> by (rule exp_adj)

	show ?thesis
	proof(intro is_cat_rKeI)
	have id_\<DD>: "cf_map (cf_id \<DD>) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_components(1)
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	then have exp_id_\<DD>:
	"exp_cat_cf \<alpha> \<DD> \<FF>\<lparr>ObjMap\<rparr>\<lparr>cf_map (cf_id \<DD>)\<rparr> = cf_map \<FF>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	have \<FF>: "cf_map \<FF> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_components(1)
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	have \<epsilon>: "ntcf_arrow (\<epsilon>\<^sub>C \<Phi>) \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<DD> \<DD>"
	by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
	have \<DD>\<DD>: "category \<beta> (cat_FUNCT \<alpha> \<DD> \<DD>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have \<CC>\<DD>: "category \<beta> (cat_FUNCT \<alpha> \<CC> \<DD>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	from
	\<epsilon> \<FF> \<alpha>\<beta> id_\<DD>
	\<DD>\<DD> \<CC>\<DD> LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
	NT.is_iso_ntcf_axioms
	have \<epsilon>_id_\<DD>: "\<epsilon>\<^sub>C ?adj_\<DD>\<eta>\<lparr>NTMap\<rparr>\<lparr>cf_map (cf_id \<DD>)\<rparr> = ntcf_arrow ?\<epsilon>"
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_Set_the_inverse[symmetric]
	cat_op_simps
	cat_cs_simps
	cat_FUNCT_cs_simps
	adj_cs_simps
	cs_intro:
	- \<DD>\<eta>.NT.iso_ntcf_is_arr_isomorphism''
	+ \<DD>\<eta>.NT.iso_ntcf_is_iso_arr''
	cat_op_intros
	adj_cs_intros
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	)
	show "universal_arrow_fo ?\<DD>\<GG> (cf_map (cf_id \<DD>)) (cf_map \<FF>) (ntcf_arrow ?\<epsilon>)"
	by
	(
	rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
	OF exp_adj id_\<DD>, unfolded exp_id_\<DD> \<epsilon>_id_\<DD>
	]
	)
	qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+

	qed

	lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
	shows "\<eta>\<^sub>C \<Phi> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<^sub>C \<DD> \<mapsto>\<^sub>C \<CC>"
	by
	(
	rule is_cat_rKe.is_cat_lKe_op
	[
	OF is_cf_adjunction.cf_adjunction_counit_is_rKe
	[
	OF is_cf_adjunction_op,
	folded op_ntcf_cf_adjunction_unit op_cf_cf_id
	],
	unfolded
	cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
	]
	)

	lemma cf_adjunction_if_lKe_preserves:
	\<comment>\<open>The statement of the theorem is similar to the statement of a part of
	Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
	or Proposition 6.5.2 in \cite{riehl_category_2016}.\<close>
	assumes "\<eta> : cf_id \<DD> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C \<CC>)"
	shows "cf_adjunction_of_unit \<alpha> \<GG> \<FF> \<eta> : \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F \<FF> : \<DD> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	interpret \<eta>: is_cat_lKe_preserves \<alpha> \<DD> \<CC> \<DD> \<CC> \<GG> \<open>cf_id \<DD>\<close> \<FF> \<GG> \<eta>
	by (rule assms)

	from \<eta>.cat_lKe_preserves interpret \<GG>\<eta>:
	is_cat_lKe \<alpha> \<DD> \<CC> \<CC> \<GG> \<GG> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<close>
	by (cs_prems cs_shallow cs_simp: cat_cs_simps)

	from
	\<GG>\<eta>.cat_lKe_unique
	[
	OF \<eta>.AG.HomCod.cat_cf_id_is_functor,
	unfolded \<eta>.AG.cf_cf_comp_cf_id_left,
	OF \<eta>.AG.cf_ntcf_id_is_ntcf
	]
	obtain \<epsilon> where \<epsilon>: "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and ntcf_id_\<GG>_def: "ntcf_id \<GG> = \<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
	by metis
	interpret \<epsilon>: is_ntcf \<alpha> \<CC> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>cf_id \<CC>\<close> \<epsilon> by (rule \<epsilon>)

	show ?thesis
	proof(rule counit_unit_is_cf_adjunction)

	show [cat_cs_simps]: "\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>) = ntcf_id \<GG>"
	by (rule ntcf_id_\<GG>_def[symmetric])

	have \<eta>_def: "\<eta> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric]
	cs_intro: cat_cs_intros
	)
	note [cat_cs_simps] = this[symmetric]

	let ?\<FF>\<epsilon>\<GG> = \<open>\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
	let ?\<eta>\<FF>\<GG> = \<open>\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
	let ?\<FF>\<GG>\<eta> = \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<close>

	have "(?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> = (?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	proof(rule ntcf_eqI)
	have dom_lhs: "\<D>\<^sub>\<circ> (((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have dom_rhs: "\<D>\<^sub>\<circ> (((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
	note category.cat_Comp_assoc[cat_cs_simps del]
	show
	"((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr> =
	((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
	then show
	"((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps \<eta>.ntcf_lKe.ntcf_Comp_commute[symmetric]
	cs_intro: cat_cs_intros
	)
	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros)+
	+ qed (cs_concl cs_intro: cat_cs_intros)+
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	also have "\<dots> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_cs_simps
	cf_comp_cf_ntcf_comp_assoc
	cf_ntcf_comp_ntcf_cf_comp_assoc
	cf_ntcf_comp_ntcf_vcomp[symmetric]
	cs_intro: cat_cs_intros
	)
	also have "\<dots> = \<eta>" by (cs_concl cs_simp: cat_cs_simps)
	finally have "(?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> = \<eta>" by simp
	then have \<eta>_def': "\<eta> = (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric]
	cs_intro: cat_cs_intros
	)+

	have \<FF>\<epsilon>\<eta>\<FF>: "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	from \<eta>.cat_lKe_unique[OF \<eta>.Lan.is_functor_axioms \<eta>.ntcf_lKe.is_ntcf_axioms]
	obtain \<sigma> where
	"\<lbrakk> \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>; \<eta> = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
	for \<sigma>'
	by metis

	from this[OF \<eta>.Lan.cf_ntcf_id_is_ntcf \<eta>_def] this[OF \<FF>\<epsilon>\<eta>\<FF> \<eta>_def'] show
	"\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) = ntcf_id \<FF>"
	by simp

	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros)+
	+ qed (cs_concl cs_intro: cat_cs_intros)+

	qed

	lemma cf_adjunction_if_rKe_preserves:
	assumes "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> cf_id \<DD> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C \<CC>)"
	shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	proof-
	interpret \<epsilon>: is_cat_rKe_preserves \<alpha> \<DD> \<CC> \<DD> \<CC> \<GG> \<open>cf_id \<DD>\<close> \<FF> \<GG> \<epsilon>
	by (rule assms)
	have "op_cf (cf_id \<DD>) = cf_id (op_cat \<DD>)" unfolding cat_op_simps by simp
	show ?thesis
	by
	(
	rule is_cf_adjunction.is_cf_adjunction_op
	[
	OF cf_adjunction_if_lKe_preserves[
	OF \<epsilon>.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
	],
	folded cf_adjunction_of_counit_def,
	unfolded cat_op_simps
	]
	)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
	@@ -1,4915 +1,2213 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	-section\<open>Limits\<close>
	+section\<open>Limits and colimits\<close>
	theory CZH_UCAT_Limit
	imports
	CZH_UCAT_Universal
	- CZH_Elementary_Categories.CZH_ECAT_Discrete
	- CZH_Elementary_Categories.CZH_ECAT_SS
	- CZH_Elementary_Categories.CZH_ECAT_Parallel
	+ CZH_Elementary_Categories.CZH_ECAT_Cone
	+ CZH_Elementary_Categories.CZH_ECAT_Small_Cone
	begin



	subsection\<open>Background\<close>

	named_theorems cat_lim_cs_simps
	named_theorems cat_lim_cs_intros



	-subsection\<open>Cone and cocone\<close>
	-
	-
	-text\<open>
	-In the context of this work, the concept of a cone corresponds to that of a cone
	-to the base of a functor from a vertex, as defined in Chapter III-4 in
	-\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
	-of a cone from the base of a functor to a vertex, as defined in Chapter III-3
	-in \cite{mac_lane_categories_2010}.
	-\<close>
	-
	-locale is_cat_cone = is_ntcf \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close> \<FF> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	- assumes cat_cone_obj[cat_lim_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	-
	-syntax "_is_cat_cone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_cone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	-
	-locale is_cat_cocone = is_ntcf \<alpha> \<JJ> \<CC> \<FF> \<open>cf_const \<JJ> \<CC> c\<close> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
	- assumes cat_cocone_obj[cat_lim_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	-
	-syntax "_is_cat_cocone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_cocone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	- shows "\<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_cone_axioms)
	-
	-mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
	- \|intro is_cat_coneI\|
	- \|dest is_cat_coneD[dest!]\|
	- \|elim is_cat_coneE[elim!]\|
	-
	-lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
	- assumes "c' = cf_const \<JJ> \<CC> c"
	- shows "\<NN> : c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding assms by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	-
	-lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'
	-
	-lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	- shows "\<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_cocone_axioms)
	-
	-mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
	- \|intro is_cat_coconeI\|
	- \|dest is_cat_coconeD[dest!]\|
	- \|elim is_cat_coconeE[elim!]\|
	-
	-lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
	- assumes "c' = cf_const \<JJ> \<CC> c"
	- shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding assms by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	-
	-lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_cone) is_cat_cocone_op:
	- "op_ntcf \<NN> : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_coconeI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros
	- )+
	-
	-lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
	- assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	- shows "op_ntcf \<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_cocone_op)
	-
	-lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'
	-
	-lemma (in is_cat_cocone) is_cat_cone_op:
	- "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_coneI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros
	- )
	-
	-lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
	- assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
	- shows "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_cone_op)
	-
	-lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-lemma (in is_cat_cone) cat_cone_LArr_app_is_arr:
	- assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	-proof-
	- from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
	-qed
	-
	-lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]:
	- assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	- shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>j"
	- using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)
	-
	-lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'
	-
	-lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr:
	- assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> c"
	-proof-
	- from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
	-qed
	-
	-lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]:
	- assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
	- shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>j \<mapsto>\<^bsub>\<CC>\<^esub> c"
	- using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)
	-
	-lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'
	-
	-lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
	- assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
	- shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	- using ntcf_Comp_commute[symmetric, OF assms] assms
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	-lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute
	-
	-lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
	- assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
	- shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- using ntcf_Comp_commute[OF assms] assms
	- by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	-lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute
	-
	-
	-text\<open>Utilities/helper lemmas.\<close>
	-
	-lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
	- assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	- and "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	- and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	- from assms(3) have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	- by simp
	- from this assms(1,2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-qed
	-
	-lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
	- assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	- and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- shows "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	-proof-
	- interpret \<NN>': is_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	- show ?thesis
	- proof(rule ntcf_eqI[OF \<NN>'.is_ntcf_axioms])
	- from assms(2) show
	- "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' : cf_const \<JJ> \<CC> c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "\<NN>'\<lparr>NTMap\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold cat_cs_simps)
	- show "vsv ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	- from assms show "\<JJ>\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- fix j assume prems': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- with assms(1,2) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros
	- )
	- qed auto
	- qed simp_all
	-qed
	-
	-lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
	- assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> \<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<longleftrightarrow>
	- f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	- using
	- helper_cat_cone_ntcf_vcomp_Comp[OF assms]
	- helper_cat_cone_Comp_ntcf_vcomp[OF assms]
	- by (intro iffI; elim conjE; intro conjI) metis+
	-
	-lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
	- assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	- and "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	- and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	-proof-
	- interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	- from assms(3) have "op_ntcf \<NN>' = op_ntcf (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" by simp
	- from this assms(2) have op_\<NN>':
	- "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	- )
	- have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	- by
	- (
	- rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
	- OF is_cat_cone_op \<NN>'.is_cat_cone_op,
	- unfolded cat_op_simps,
	- OF assms(2) op_\<NN>' assms(4)
	- ]
	- )
	- from this assms(2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	- )
	-qed
	-
	-lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
	- assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	- and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	- shows "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	-proof-
	- interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
	- from assms(2) have \<NN>'j: "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	- if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	- using that
	- unfolding assms(3)[OF that]
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros
	- )
	- have op_\<NN>':
	- "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	- by
	- (
	- rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
	- OF is_cat_cone_op \<NN>'.is_cat_cone_op,
	- unfolded cat_op_simps,
	- OF assms(2) \<NN>'j,
	- simplified
	- ]
	- )
	- from assms(2) show "\<NN>' = (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp:
	- cat_op_simps op_\<NN>' eq_op_ntcf_iff[symmetric, OF \<NN>'.is_ntcf_axioms]
	- cs_intro: cat_cs_intros
	- )
	-qed
	-
	-lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
	- assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> \<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<longleftrightarrow>
	- f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	- using
	- helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
	- helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
	- by (intro iffI; elim conjE; intro conjI) metis+
	-
	-
	-
	subsection\<open>Limit and colimit\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The concept of a limit is introduced in Chapter III-4 in
	\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
	Chapter III-3 in \cite{mac_lane_categories_2010}.
	\<close>

	locale is_cat_limit = is_cat_cone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u +
	assumes cat_lim_ua_fo: "\<And>u' r'. u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"

	syntax "_is_cat_limit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	"CONST is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u"

	locale is_cat_colimit = is_cat_cocone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u +
	assumes cat_colim_ua_of: "\<And>u' r'. u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"

	syntax "_is_cat_colimit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	"CONST is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u"


	text\<open>Rules.\<close>

	lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	shows "u : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_limit_axioms)

	mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
	\|intro is_cat_limitI\|
	\|dest is_cat_limitD[dest]\|
	\|elim is_cat_limitE[elim]\|

	lemmas [cat_lim_cs_intros] = is_cat_limitD(1)

	lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	shows "u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_colimit_axioms)

	mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
	\|intro is_cat_colimitI\|
	\|dest is_cat_colimitD[dest]\|
	\|elim is_cat_colimitE[elim]\|

	lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)


	text\<open>Limits, colimits and universal arrows.\<close>

	lemma (in is_cat_limit) cat_lim_is_universal_arrow_fo:
	"universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
	proof(intro is_functor.universal_arrow_foI)

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
	by
	(
	intro
	\<beta> \<alpha>\<beta>
	cf_diagonal_is_functor
	NTDom.HomDom.category_axioms
	NTDom.HomCod.category_axioms
	)

	show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cone_obj)
	then show "ntcf_arrow u : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	fix r' u' assume prems:
	"r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	from prems(1) have [cat_cs_simps]:
	"cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
	"cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
	from prems(2,1) have
	"u' : cf_map (cf_const \<JJ> \<CC> r') \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	note u'[unfolded cat_cs_simps] = cat_FUNCT_is_arrD[OF this]

	from cat_lim_ua_fo[OF is_cat_coneI[OF u'(1) prems(1)]] obtain f
	where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and [symmetric, cat_cs_simps]:
	"ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	and f_unique:
	"\<lbrakk>
	f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
	ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'
	\<rbrakk> \<Longrightarrow> f' = f"
	for f'
	by metis

	show "\<exists>!f'.
	f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and>
	u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof(intro ex1I conjI; (elim conjE)?)
	show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
	with \<alpha>\<beta> cat_cone_obj show u'_def:
	"u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	fix f' assume prems':
	"f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	"u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	from prems'(2) \<alpha>\<beta> f prems' cat_cone_obj have u'_def':
	"u' = ntcf_arrow (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros
	)
	from f_unique[OF prems'(1) this] show "f' = f" .

	qed

	qed

	lemma (in is_cat_cone) cat_cone_is_cat_limit:
	assumes "universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
	shows "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(intro is_cat_limitI is_cat_cone_axioms)
	fix u' c' assume prems: "u' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"

	interpret u': is_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)

	from u'.cat_cone_obj have u'_is_arr:
	"ntcf_arrow u' : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	from is_functor.universal_arrow_foD(3)
	[
	OF
	cf_diagonal_is_functor[
	OF \<beta> \<alpha>\<beta> NTDom.HomDom.category_axioms NTDom.HomCod.category_axioms
	]
	assms
	u'.cat_cone_obj
	u'_is_arr
	]
	obtain f where f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and u'_def': "ntcf_arrow u' =
	umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	and f'_unique:
	"\<lbrakk>
	f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c;
	ntcf_arrow u' =
	umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> f' = f"
	for f'
	by metis

	from u'_def' \<alpha>\<beta> f cat_cone_obj have u'_def:
	"u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	show "\<exists>!f'. f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
	fix f'' assume prems':
	"f'' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c" "u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f''"
	from \<alpha>\<beta> prems' have
	"ntcf_arrow u' =
	umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
	- by
	+ by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from f'_unique[OF prems'(1) this] show "f'' = f".
	qed

	qed

	qed

	lemma (in is_cat_colimit) cat_colim_is_universal_arrow_of:
	"universal_arrow_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
	proof(intro is_functor.universal_arrow_ofI)

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
	by
	(
	intro
	\<beta> \<alpha>\<beta>
	cf_diagonal_is_functor
	NTDom.HomDom.category_axioms
	NTDom.HomCod.category_axioms
	)

	show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cocone_obj)

	then show "ntcf_arrow u : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	fix r' u' assume prems:
	"r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	from prems(1) have [cat_cs_simps]:
	"cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
	"cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
	from prems(2,1) have
	"u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map (cf_const \<JJ> \<CC> r')"
	by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	note u'[unfolded cat_cs_simps] = cat_FUNCT_is_arrD[OF this]

	from cat_colim_ua_of[OF is_cat_coconeI[OF u'(1) prems(1)]] obtain f
	where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	and [symmetric, cat_cs_simps]:
	"ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	and f_unique:
	"\<lbrakk>
	f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r';
	ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u
	\<rbrakk> \<Longrightarrow> f' = f"
	for f'
	by metis

	show " \<exists>!f'.
	f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and>
	u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof(intro ex1I conjI; (elim conjE)?)

	show "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by (rule f)
	with \<alpha>\<beta> cat_cocone_obj show u'_def:
	"u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by
	(
	- cs_concl cs_shallow
	+ cs_concl
	cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	fix f' assume prems':
	"f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	"u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	from prems'(2) \<alpha>\<beta> f prems' cat_cocone_obj have u'_def':
	"u' = ntcf_arrow (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros
	)
	from f_unique[OF prems'(1) this] show "f' = f" .

	qed

	qed

	lemma (in is_cat_cocone) cat_cocone_is_cat_colimit:
	assumes "universal_arrow_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
	shows "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	show ?thesis
	proof(intro is_cat_colimitI is_cat_cocone_axioms)

	fix u' c' assume prems: "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"

	interpret u': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)

	from u'.cat_cocone_obj have u'_is_arr:
	"ntcf_arrow u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	from is_functor.universal_arrow_ofD(3)
	[
	OF
	cf_diagonal_is_functor[
	OF \<beta> \<alpha>\<beta> NTDom.HomDom.category_axioms NTDom.HomCod.category_axioms
	]
	assms
	u'.cat_cocone_obj
	u'_is_arr
	]
	obtain f where f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	and u'_def': "ntcf_arrow u' =
	umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	and f'_unique:
	"\<lbrakk>
	f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c';
	ntcf_arrow u' =
	umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> f' = f"
	for f'
	by metis

	from u'_def' \<alpha>\<beta> f cat_cocone_obj have u'_def:
	"u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	show "\<exists>!f'. f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
	fix f'' assume prems':
	"f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'" "u' = ntcf_const \<JJ> \<CC> f'' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	from \<alpha>\<beta> prems' have
	"ntcf_arrow u' =
	umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from f'_unique[OF prems'(1) this] show "f'' = f".
	qed

	qed

	qed


	text\<open>Duality.\<close>

	lemma (in is_cat_limit) is_cat_colimit_op:
	"op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	proof(intro is_cat_colimitI)
	show "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by (cs_concl cs_shallow cs_simp: cs_intro: cat_op_intros)
	fix u' r' assume prems:
	"u' : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	interpret u': is_cat_cocone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u'
	by (rule prems)
	from cat_lim_ua_fo[OF u'.is_cat_cone_op[unfolded cat_op_simps]] obtain f
	where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and op_u'_def: "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	and f_unique:
	"\<lbrakk> f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r; op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<rbrakk> \<Longrightarrow>
	f' = f"
	for f'
	by metis
	from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)"
	by simp
	from this f have u'_def:
	"u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	- by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	show "\<exists>!f'.
	f' : r \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r' \<and>
	u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
	fix f' assume prems':
	"f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	"u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	from prems'(2) have
	"op_ntcf u' = op_ntcf (ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u)"
	by simp
	from this prems'(1) have "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	from f_unique[OF prems'(1) this] show "f' = f".
	qed (intro u'_def f)+
	qed

	lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
	assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_colimit_op)

	lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'

	lemma (in is_cat_colimit) is_cat_limit_op:
	"op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	proof(intro is_cat_limitI)
	show "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by (cs_concl cs_shallow cs_simp: cs_intro: cat_op_intros)
	fix u' r' assume prems:
	"u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	interpret u': is_cat_cone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u'
	by (rule prems)
	from cat_colim_ua_of[OF u'.is_cat_cocone_op[unfolded cat_op_simps]] obtain f
	where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	and op_u'_def: "op_ntcf u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	and f_unique:
	"\<lbrakk> f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'; op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u \<rbrakk> \<Longrightarrow>
	f' = f"
	for f'
	by metis
	from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
	by simp
	from this f have u'_def:
	"u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	- by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	show "\<exists>!f'.
	f' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r \<and>
	u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
	fix f' assume prems':
	"f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	"u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	from prems'(2) have
	"op_ntcf u' = op_ntcf (op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f')"
	by simp
	from this prems'(1) have "op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	- by
	+ by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	from f_unique[OF prems'(1) this] show "f' = f".
	qed (intro u'_def f)+
	qed

	lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
	assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_limit_op)

	lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'


	subsubsection\<open>Universal property\<close>

	lemma (in is_cat_limit) cat_lim_unique_cone':
	assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
	(intro cat_lim_ua_fo assms)

	lemma (in is_cat_limit) cat_lim_unique:
	assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	by (intro cat_lim_ua_fo[OF is_cat_limitD(1)[OF assms]])

	lemma (in is_cat_limit) cat_lim_unique':
	assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])

	lemma (in is_cat_colimit) cat_colim_unique_cocone:
	assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	proof-
	interpret u': is_cat_cocone \<alpha> r' \<JJ> \<CC> \<FF> u' by (rule assms(1))
	from u'.cat_cocone_obj have op_r': "r' \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
	unfolding cat_op_simps by simp
	from
	is_cat_limit.cat_lim_ua_fo[
	OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
	]
	obtain f' where f': "f' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r"
	and [cat_cs_simps]:
	"op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f')"
	and unique:
	"\<lbrakk>
	f'' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r;
	op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f'')
	\<rbrakk> \<Longrightarrow> f'' = f'"
	for f''
	by metis
	show ?thesis
	proof(intro ex1I conjI; (elim conjE)?)
	from f' show f': "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" unfolding cat_op_simps by simp
	show "u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
	- (
	- cs_concl cs_shallow
	- cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps
	- )+
	+ (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
	fix f'' assume prems: "f'' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" "u' = ntcf_const \<JJ> \<CC> f'' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	from prems(1) have "f'' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r" unfolding cat_op_simps by simp
	moreover from prems(1) have
	"op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f'')"
	unfolding prems(2)
	- by
	- (
	- cs_concl cs_shallow
	- cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps
	- )
	+ by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
	ultimately show "f'' = f'" by (rule unique)
	qed
	qed

	lemma (in is_cat_colimit) cat_colim_unique_cocone':
	assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
	(intro cat_colim_unique_cocone assms)

	lemma (in is_cat_colimit) cat_colim_unique:
	assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])

	lemma (in is_cat_colimit) cat_colim_unique':
	assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows
	"\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	proof-
	interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(1))
	show ?thesis
	by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
	(intro cat_colim_unique assms)
	qed

	-lemma cat_lim_ex_is_arr_isomorphism:
	+lemma cat_lim_ex_is_iso_arr:
	assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains f where "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" and "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	proof-
	interpret u: is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
	interpret u': is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def u.\<Z>_Limit_\<alpha>\<omega> u.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def u.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp
	have \<Delta>: "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
	by
	(
	intro
	\<beta> \<alpha>\<beta>
	cf_diagonal_is_functor
	u.NTDom.HomDom.category_axioms
	u.NTDom.HomCod.category_axioms
	)
	then interpret \<Delta>: is_functor \<beta> \<CC> \<open>cat_FUNCT \<alpha> \<JJ> \<CC>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<close> by simp
	- from is_functor.cf_universal_arrow_fo_ex_is_arr_isomorphism[
	+ from is_functor.cf_universal_arrow_fo_ex_is_iso_arr[
	OF \<Delta> u.cat_lim_is_universal_arrow_fo u'.cat_lim_is_universal_arrow_fo
	]
	obtain f where f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	and u': "ntcf_arrow u' =
	umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by auto
	from f have "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
	from u' this have "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	with f that show ?thesis by simp
	qed

	-lemma cat_lim_ex_is_arr_isomorphism':
	+lemma cat_lim_ex_is_iso_arr':
	assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains f where "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	proof-
	interpret u: is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
	interpret u': is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
	from assms obtain f
	where iso_f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" and u'_def: "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	- by (rule cat_lim_ex_is_arr_isomorphism)
	+ by (rule cat_lim_ex_is_iso_arr)
	then have f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
	then have "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	by
	(
	intro u.helper_cat_cone_ntcf_vcomp_Comp[
	OF u'.is_cat_cone_axioms f u'_def that
	]
	)
	with iso_f that show ?thesis by simp
	qed

	-lemma cat_colim_ex_is_arr_isomorphism:
	+lemma cat_colim_ex_is_iso_arr:
	assumes "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains f where "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" and "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	proof-
	interpret u: is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
	interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
	obtain f where f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>op_cat \<CC>\<^esub> r"
	and [cat_cs_simps]:
	"op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	by
	(
	- elim cat_lim_ex_is_arr_isomorphism[
	+ elim cat_lim_ex_is_iso_arr[
	OF u.is_cat_limit_op u'.is_cat_limit_op
	]
	)
	from f have iso_f: "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" unfolding cat_op_simps by simp
	then have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by auto
	have "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
	- (
	- cs_concl cs_shallow
	- cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps
	- )+
	+ (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
	from iso_f this that show ?thesis by simp
	qed

	-lemma cat_colim_ex_is_arr_isomorphism':
	+lemma cat_colim_ex_is_iso_arr':
	assumes "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	obtains f where "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'"
	and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	proof-
	interpret u: is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
	interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
	from assms obtain f
	where iso_f: "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" and u'_def: "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	- by (rule cat_colim_ex_is_arr_isomorphism)
	+ by (rule cat_colim_ex_is_iso_arr)
	then have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by auto
	then have "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	by
	(
	intro u.helper_cat_cocone_ntcf_vcomp_Comp[
	OF u'.is_cat_cocone_axioms f u'_def that
	]
	)
	with iso_f that show ?thesis by simp
	qed


	subsubsection\<open>Further properties\<close>

	+lemma (in is_cat_limit) cat_lim_is_cat_limit_if_is_iso_arr:
	+ assumes "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	+ shows "u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ note f = is_iso_arrD(1)[OF assms(1)]
	+ from f(1) interpret u': is_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> \<open>u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f\<close>
	+ by (cs_concl cs_intro: cat_lim_cs_intros cat_cs_intros)
	+ define \<beta> where "\<beta> = \<alpha> + \<omega>"
	+ have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	+ by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
	+ then interpret \<beta>: \<Z> \<beta> by simp
	+ show ?thesis
	+ proof
	+ (
	+ intro u'.cat_cone_is_cat_limit,
	+ rule is_functor.universal_arrow_fo_if_universal_arrow_fo,
	+ rule cf_diagonal_is_functor[OF \<beta> \<alpha>\<beta>],
	+ rule NTDom.HomDom.category_axioms,
	+ rule NTDom.HomCod.category_axioms,
	+ rule cat_lim_is_universal_arrow_fo
	+ )
	+ show "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" by (rule assms(1))
	+ from \<alpha>\<beta> f show
	+ "ntcf_arrow (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f) =
	+ umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ qed
	+qed
	+
	+lemma (in is_cat_colimit) cat_colim_is_cat_colimit_if_is_iso_arr:
	+ assumes "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'"
	+ shows "ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ note f = is_iso_arrD[OF assms(1)]
	+ from f(1) interpret u': is_cat_cocone \<alpha> r' \<JJ> \<CC> \<FF> \<open>ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u\<close>
	+ by (cs_concl cs_intro: cat_lim_cs_intros cat_cs_intros)
	+ from f have [symmetric, cat_op_simps]:
	+ "op_ntcf (ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u) =
	+ op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_limit.is_cat_colimit_op
	+ [
	+ OF is_cat_limit.cat_lim_is_cat_limit_if_is_iso_arr[
	+ OF is_cat_limit_op, unfolded cat_op_simps, OF assms(1)
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	lemma ntcf_cf_comp_is_cat_limit_if_is_iso_functor:
	assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	shows "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof(intro is_cat_limitI)
	interpret u: is_cat_limit \<alpha> \<BB> \<CC> \<FF> r u by (rule assms(1))
	interpret \<GG>: is_iso_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(2))
	- note [cf_cs_simps] = is_iso_functor_is_arr_isomorphism(2,3)
	- show u\<GG>: "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ note [cf_cs_simps] = is_iso_functor_is_iso_arr(2,3)
	+ show u\<GG>: "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (intro is_cat_coneI)
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
	- )
	+ (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	then interpret u': is_cat_cone \<alpha> r' \<AA> \<CC> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> u' by simp
	have "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	by (intro is_cat_coneI)
	(
	- cs_concl
	+ cs_concl
	cs_simp: cat_cs_simps cf_cs_simps
	- cs_intro: cat_cs_intros cat_lim_cs_intros cf_cs_intros
	+ cs_intro: cat_cs_intros cf_cs_intros
	)
	from is_cat_limit.cat_lim_ua_fo[OF assms(1) this] obtain f
	where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	and u'_\<GG>: "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f"
	and f'f:
	"\<lbrakk>
	f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
	u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f'
	\<rbrakk> \<Longrightarrow> f' = f"
	for f'
	by metis
	from u'_\<GG> have u'_inv\<GG>_\<GG>:
	"(u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> = (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>"
	by simp
	show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f'"
	proof(intro ex1I conjI; (elim conjE)?)
	show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
	from u'_inv\<GG>_\<GG> f show "u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f"
	by
	(
	- cs_prems cs_shallow
	+ cs_prems
	cs_simp:
	cf_cs_simps cat_cs_simps
	ntcf_cf_comp_ntcf_cf_comp_assoc
	ntcf_vcomp_ntcf_cf_comp[symmetric]
	cs_intro: cat_cs_intros cf_cs_intros
	)
	fix f' assume prems:
	"f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" "u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f'"
	from prems(2) have
	"u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> =
	(u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f') \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG>"
	by simp
	from this f prems(1) have "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f'"
	by
	(
	cs_prems
	cs_simp:
	cat_cs_simps cf_cs_simps
	ntcf_vcomp_ntcf_cf_comp[symmetric]
	ntcf_cf_comp_ntcf_cf_comp_assoc
	cs_intro: cf_cs_intros cat_cs_intros
	)
	then show "f' = f" by (intro f'f prems(1))
	qed
	qed

	lemma ntcf_cf_comp_is_cat_limit_if_is_iso_functor'[cat_lim_cs_intros]:
	assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
	and "\<AA>' = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
	shows "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<AA>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1,2)
	unfolding assms(3)
	by (rule ntcf_cf_comp_is_cat_limit_if_is_iso_functor)



	+subsection\<open>Small limit and small colimit\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+The concept of a limit is introduced in Chapter III-4 in
	+\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
	+Chapter III-3 in \cite{mac_lane_categories_2010}. The definitions of small
	+limits were tailored for ZFC in HOL.
	+\<close>
	+
	+locale is_tm_cat_limit = is_tm_cat_cone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u +
	+ assumes tm_cat_lim_ua_fo:
	+ "\<And>u' r'. u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+
	+syntax "_is_tm_cat_limit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u"
	+
	+locale is_tm_cat_colimit = is_tm_cat_cocone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u +
	+ assumes tm_cat_colim_ua_of:
	+ "\<And>u' r'. u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+
	+syntax "_is_tm_cat_colimit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_tm_cat_limit) is_tm_cat_limit_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "u : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_limit_axioms)
	+
	+mk_ide rf is_tm_cat_limit_def[unfolded is_tm_cat_limit_axioms_def]
	+ \|intro is_tm_cat_limitI\|
	+ \|dest is_tm_cat_limitD[dest]\|
	+ \|elim is_tm_cat_limitE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_tm_cat_limitD(1)
	+
	+lemma (in is_tm_cat_colimit) is_tm_cat_colimit_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	+ shows "u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_colimit_axioms)
	+
	+mk_ide rf is_tm_cat_colimit_def[unfolded is_tm_cat_colimit_axioms_def]
	+ \|intro is_tm_cat_colimitI\|
	+ \|dest is_tm_cat_colimitD[dest]\|
	+ \|elim is_tm_cat_colimitE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_tm_cat_colimitD(1)
	+
	+lemma is_tm_cat_limitI':
	+ assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>u' r'. u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ shows "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(rule is_tm_cat_limitI, rule assms(1))
	+ interpret is_tm_cat_cone \<alpha> r \<JJ> \<CC> \<FF> u by (rule assms(1))
	+ fix r' u' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ then interpret u': is_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> u' .
	+ have "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ intro
	+ is_tm_cat_coneI
	+ NTCod.is_tm_functor_axioms
	+ u'.cat_cone_obj
	+ u'.is_ntcf_axioms
	+ )
	+ then show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ by (rule assms(2))
	+qed
	+
	+lemma is_tm_cat_colimitI':
	+ assumes "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<And>u' r'. u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ shows "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_tm_cat_colimitI, rule assms(1))
	+ interpret is_tm_cat_cocone \<alpha> r \<JJ> \<CC> \<FF> u by (rule assms(1))
	+ fix r' u' assume prems: "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ then interpret u': is_cat_cocone \<alpha> r' \<JJ> \<CC> \<FF> u' .
	+ have "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ intro
	+ is_tm_cat_coconeI
	+ NTDom.is_tm_functor_axioms
	+ u'.cat_cocone_obj
	+ u'.is_ntcf_axioms
	+ )
	+ then show "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ by (rule assms(2))
	+qed
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+sublocale is_tm_cat_limit \<subseteq> is_cat_limit
	+ by (intro is_cat_limitI, rule is_cat_cone_axioms, rule tm_cat_lim_ua_fo)
	+
	+sublocale is_tm_cat_colimit \<subseteq> is_cat_colimit
	+ by (intro is_cat_colimitI, rule is_cat_cocone_axioms, rule tm_cat_colim_ua_of)
	+
	+lemma (in is_cat_limit) cat_lim_is_tm_cat_limit:
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_tm_cat_limitI)
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms)
	+ show "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (intro is_tm_cat_coneI assms is_ntcf_axioms cat_cone_obj)
	+ fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ by (rule cat_lim_ua_fo[OF prems])
	+qed
	+
	+lemma (in is_cat_colimit) cat_colim_is_tm_cat_colimit:
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_tm_cat_colimitI)
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms)
	+ show "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (intro is_tm_cat_coconeI assms is_ntcf_axioms cat_cocone_obj)
	+ fix u' r' assume prems: "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ show "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ by (rule cat_colim_ua_of[OF prems])
	+qed
	+
	+
	+text\<open>Limits, colimits and universal arrows.\<close>
	+
	+lemma (in is_tm_cat_limit) tm_cat_lim_is_universal_arrow_fo:
	+ "universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
	+proof(intro is_functor.universal_arrow_foI)
	+
	+ show "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Funct \<alpha> \<JJ> \<CC>"
	+ by
	+ (
	+ intro
	+ tm_cf_diagonal_is_functor
	+ NTCod.HomDom.tiny_category_axioms
	+ NTDom.HomCod.category_axioms
	+ )
	+
	+ show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cone_obj)
	+ then show "ntcf_arrow u : \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ fix r' u' assume prems:
	+ "r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	+ from prems(1) have [cat_cs_simps]:
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
	+ by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
	+ from prems(2,1) have
	+ "u' : cf_map (cf_const \<JJ> \<CC> r') \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	+ note u'[unfolded cat_cs_simps] = cat_Funct_is_arrD[OF this]
	+
	+ from
	+ tm_cat_lim_ua_fo[
	+ OF is_cat_coneI[OF is_tm_ntcfD(1)[OF u'(1)] prems(1)]
	+ ]
	+ obtain f
	+ where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ and [symmetric, cat_cs_simps]:
	+ "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ and f_unique:
	+ "\<lbrakk>
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
	+ ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+
	+ show "\<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and>
	+ u' = umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
	+ with cat_cone_obj show u'_def:
	+ "u' = umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ fix f' assume prems':
	+ "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ "u' = umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ from prems'(2) f prems' cat_cone_obj have u'_def':
	+ "u' = ntcf_arrow (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ by (cs_concl cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros)
	+ from f_unique[OF prems'(1) this] show "f' = f" .
	+
	+ qed
	+
	+qed
	+
	+lemma (in is_tm_cat_cone) tm_cat_cone_is_tm_cat_limit:
	+ assumes "universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
	+ shows "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_tm_cat_limitI' is_tm_cat_cone_axioms)
	+
	+ fix u' c' assume prems: "u' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+
	+ interpret u': is_tm_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)
	+
	+ from u'.tm_cat_cone_obj have u'_is_arr:
	+ "ntcf_arrow u' : \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ from is_functor.universal_arrow_foD(3)
	+ [
	+ OF
	+ tm_cf_diagonal_is_functor[
	+ OF NTCod.HomDom.tiny_category_axioms NTDom.HomCod.category_axioms
	+ ]
	+ assms
	+ u'.cat_cone_obj
	+ u'_is_arr
	+ ]
	+ obtain f where f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and u'_def': "ntcf_arrow u' =
	+ umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ and f'_unique:
	+ "\<lbrakk>
	+ f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c;
	+ ntcf_arrow u' =
	+ umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+
	+ from u'_def' f cat_cone_obj have u'_def: "u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ show "\<exists>!f'. f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
	+ fix f'' assume prems':
	+ "f'' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c" "u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f''"
	+ from prems' have
	+ "ntcf_arrow u' =
	+ umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from f'_unique[OF prems'(1) this] show "f'' = f".
	+ qed
	+
	+qed
	+
	+lemma (in is_tm_cat_colimit) tm_cat_colim_is_universal_arrow_of:
	+ "universal_arrow_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
	+proof(intro is_functor.universal_arrow_ofI)
	+
	+ show "\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Funct \<alpha> \<JJ> \<CC>"
	+ by
	+ (
	+ intro
	+ tm_cf_diagonal_is_functor
	+ NTDom.HomDom.tiny_category_axioms
	+ NTDom.HomCod.category_axioms
	+ )
	+
	+ show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cocone_obj)
	+
	+ then show "ntcf_arrow u : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ fix r' u' assume prems:
	+ "r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+ from prems(1) have [cat_cs_simps]:
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
	+ by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
	+ from prems(2,1) have
	+ "u' : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> cf_map (cf_const \<JJ> \<CC> r')"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	+ note u'[unfolded cat_cs_simps] = cat_Funct_is_arrD[OF this]
	+
	+ from cat_colim_ua_of[OF is_cat_coconeI[OF is_tm_ntcfD(1)[OF u'(1)] prems(1)]]
	+ obtain f
	+ where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	+ and [symmetric, cat_cs_simps]:
	+ "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ and f_unique:
	+ "\<lbrakk>
	+ f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r';
	+ ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+
	+ show " \<exists>!f'.
	+ f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and>
	+ u' = umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+
	+ show "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by (rule f)
	+
	+ with cat_cocone_obj show u'_def:
	+ "u' = umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ fix f' assume prems':
	+ "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	+ "u' = umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ from prems'(2) f prems' cat_cocone_obj have u'_def':
	+ "u' = ntcf_arrow (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros
	+ )
	+ from f_unique[OF prems'(1) this] show "f' = f" .
	+
	+ qed
	+
	+qed
	+
	+lemma (in is_tm_cat_cocone) tm_cat_cocone_is_tm_cat_colimit:
	+ assumes "universal_arrow_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
	+ shows "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_tm_cat_colimitI' is_tm_cat_cocone_axioms)
	+
	+ fix u' c' assume prems: "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+
	+ interpret u': is_tm_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)
	+
	+ from u'.tm_cat_cocone_obj have u'_is_arr:
	+ "ntcf_arrow u' : cf_map \<FF> \<mapsto>\<^bsub>cat_Funct \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ from is_functor.universal_arrow_ofD(3)
	+ [
	+ OF
	+ tm_cf_diagonal_is_functor[
	+ OF NTDom.HomDom.tiny_category_axioms NTDom.HomCod.category_axioms
	+ ]
	+ assms
	+ u'.cat_cocone_obj
	+ u'_is_arr
	+ ]
	+ obtain f where f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
	+ and u'_def': "ntcf_arrow u' =
	+ umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ and f'_unique:
	+ "\<lbrakk>
	+ f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c';
	+ ntcf_arrow u' =
	+ umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+
	+ from u'_def' f cat_cocone_obj have u'_def: "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+
	+ show "\<exists>!f'. f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	+ proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
	+ fix f'' assume prems':
	+ "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'" "u' = ntcf_const \<JJ> \<CC> f'' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
	+ from prems' have
	+ "ntcf_arrow u' =
	+ umap_of (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from f'_unique[OF prems'(1) this] show "f'' = f".
	+ qed
	+
	+qed
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_tm_cat_limit) is_tm_cat_colimit_op:
	+ "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+proof(intro is_tm_cat_colimitI')
	+ show "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (cs_concl cs_shallow cs_simp: cs_intro: cat_op_intros)
	+ fix u' r' assume prems:
	+ "u' : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ interpret u': is_tm_cat_cocone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u'
	+ by (rule prems)
	+ from tm_cat_lim_ua_fo[OF u'.is_cat_cone_op[unfolded cat_op_simps]] obtain f
	+ where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ and op_u'_def: "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ and f_unique:
	+ "\<lbrakk> f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r; op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<rbrakk> \<Longrightarrow>
	+ f' = f"
	+ for f'
	+ by metis
	+ from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)"
	+ by simp
	+ from this f have u'_def:
	+ "u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	+ show "\<exists>!f'.
	+ f' : r \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r' \<and>
	+ u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	+ proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
	+ fix f' assume prems':
	+ "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ "u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
	+ from prems'(2) have "op_ntcf u' =
	+ op_ntcf (ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u)"
	+ by simp
	+ from this prems'(1) have "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ from f_unique[OF prems'(1) this] show "f' = f".
	+ qed (intro u'_def f)+
	+qed
	+
	+lemma (in is_tm_cat_limit) is_tm_cat_colimit_op'[cat_op_intros]:
	+ assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_colimit_op)
	+
	+lemmas [cat_op_intros] = is_tm_cat_limit.is_tm_cat_colimit_op'
	+
	+lemma (in is_tm_cat_colimit) is_tm_cat_limit_op:
	+ "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+proof(intro is_tm_cat_limitI')
	+ show "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (cs_concl cs_shallow cs_simp: cs_intro: cat_op_intros)
	+ fix u' r' assume prems:
	+ "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ interpret u': is_tm_cat_cone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u'
	+ by (rule prems)
	+ from tm_cat_colim_ua_of[OF u'.is_cat_cocone_op[unfolded cat_op_simps]] obtain f
	+ where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	+ and op_u'_def: "op_ntcf u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ and f_unique:
	+ "\<lbrakk> f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'; op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+ from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
	+ by simp
	+ from this f have u'_def:
	+ "u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	+ show "\<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r \<and>
	+ u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	+ proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
	+ fix f' assume prems':
	+ "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
	+ "u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
	+ from prems'(2) have "op_ntcf u' =
	+ op_ntcf (op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f')"
	+ by simp
	+ from this prems'(1) have "op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ from f_unique[OF prems'(1) this] show "f' = f".
	+ qed (intro u'_def f)+
	+qed
	+
	+lemma (in is_tm_cat_colimit) is_tm_cat_colimit_op'[cat_op_intros]:
	+ assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_limit_op)
	+
	+lemmas [cat_op_intros] = is_tm_cat_colimit.is_tm_cat_colimit_op'
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_tm_cat_limit) tm_cat_lim_is_tm_cat_limit_if_iso_arr:
	+ assumes "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
	+ shows "u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ note f = is_iso_arrD(1)[OF assms]
	+ from f(1) interpret u': is_tm_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> \<open>u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f\<close>
	+ by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
	+ show ?thesis
	+ proof
	+ (
	+ intro u'.tm_cat_cone_is_tm_cat_limit,
	+ rule is_functor.universal_arrow_fo_if_universal_arrow_fo,
	+ rule tm_cf_diagonal_is_functor,
	+ rule NTCod.HomDom.tiny_category_axioms,
	+ rule NTDom.HomCod.category_axioms,
	+ rule tm_cat_lim_is_universal_arrow_fo
	+ )
	+ show "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" by (rule assms)
	+ from f show "ntcf_arrow (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f) =
	+ umap_fo (\<Delta>\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ qed
	+qed
	+
	+lemma (in is_tm_cat_colimit) tm_cat_colim_is_tm_cat_colimit_if_iso_arr:
	+ assumes "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'"
	+ shows "ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ note f = is_iso_arrD(1)[OF assms]
	+ from f(1) interpret u':
	+ is_tm_cat_cocone \<alpha> r' \<JJ> \<CC> \<FF> \<open>ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u\<close>
	+ by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
	+ from f have [symmetric, cat_op_simps]:
	+ "op_ntcf (ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u) =
	+ op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ show ?thesis
	+ by
	+ (
	+ rule is_tm_cat_limit.is_tm_cat_colimit_op
	+ [
	+ OF is_tm_cat_limit.tm_cat_lim_is_tm_cat_limit_if_iso_arr[
	+ OF is_tm_cat_limit_op, unfolded cat_op_simps, OF assms(1)
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+
	+
	subsection\<open>Finite limit and finite colimit\<close>

	-locale is_cat_finite_limit = is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u + finite_category \<alpha> \<JJ>
	+locale is_cat_finite_limit =
	+ is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u + NTDom.HomDom: finite_category \<alpha> \<JJ>
	for \<alpha> \<JJ> \<CC> \<FF> r u

	syntax "_is_cat_finite_limit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	"CONST is_cat_finite_limit \<alpha> \<JJ> \<CC> \<FF> r u"

	-locale is_cat_finite_colimit = is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u + finite_category \<alpha> \<JJ>
	+locale is_cat_finite_colimit =
	+ is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u + NTDom.HomDom: finite_category \<alpha> \<JJ>
	for \<alpha> \<JJ> \<CC> \<FF> r u

	syntax "_is_cat_finite_colimit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	translations "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	"CONST is_cat_finite_colimit \<alpha> \<JJ> \<CC> \<FF> r u"


	text\<open>Rules.\<close>

	lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	shows "u : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_finite_limit_axioms)

	mk_ide rf is_cat_finite_limit_def
	\|intro is_cat_finite_limitI\|
	\|dest is_cat_finite_limitD[dest]\|
	\|elim is_cat_finite_limitE[elim]\|

	lemmas [cat_lim_cs_intros] = is_cat_finite_limitD

	lemma (in is_cat_finite_colimit)
	is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
	assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
	shows "u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_finite_colimit_axioms)

	mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
	\|intro is_cat_finite_colimitI\|
	\|dest is_cat_finite_colimitD[dest]\|
	\|elim is_cat_finite_colimitE[elim]\|

	lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD


	text\<open>Duality.\<close>

	lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
	"op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by
	+ by
	(
	- cs_concl cs_shallow
	+ cs_concl cs_shallow
	cs_intro: is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
	)

	lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
	assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_finite_colimit_op)

	lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'

	lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
	"op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	by
	(
	cs_concl cs_shallow
	cs_intro: is_cat_finite_limitI cat_op_intros cat_small_cs_intros
	)

	lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
	assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	unfolding assms by (rule is_cat_finite_limit_op)

	lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'


	-
	-subsection\<open>Product and coproduct\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-
	-text\<open>
	-The definition of the product object is a specialization of the
	-definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
	-In the definition presented below, the discrete category that is used in the
	-definition presented in \cite{mac_lane_categories_2010} is parameterized by
	-an index set and the functor from the discrete category is
	-parameterized by a function from the index set to the set of
	-the objects of the category.
	-\<close>
	-
	-locale is_cat_obj_prod =
	- is_cat_limit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> P \<pi> + cf_discrete \<alpha> I A \<CC>
	- for \<alpha> I A \<CC> P \<pi>
	-
	-syntax "_is_cat_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_prod \<alpha> I A \<CC> P \<pi>"
	-
	-locale is_cat_obj_coprod =
	- is_cat_colimit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> U \<pi> + cf_discrete \<alpha> I A \<CC>
	- for \<alpha> I A \<CC> U \<pi>
	-
	-syntax "_is_cat_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_coprod \<alpha> I A \<CC> U \<pi>"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	- shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_prod_axioms)
	+text\<open>Elementary properties.\<close>

	-mk_ide rf is_cat_obj_prod_def
	- \|intro is_cat_obj_prodI\|
	- \|dest is_cat_obj_prodD[dest]\|
	- \|elim is_cat_obj_prodE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_prodD
	-
	-lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	- shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_coprod_axioms)
	-
	-mk_ide rf is_cat_obj_coprod_def
	- \|intro is_cat_obj_coprodI\|
	- \|dest is_cat_obj_coprodD[dest]\|
	- \|elim is_cat_obj_coprodE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
	- "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- using cf_discrete_vdomain_vsubset_Vset
	- by (intro is_cat_obj_coprodI)
	+sublocale is_cat_finite_limit \<subseteq> is_tm_cat_limit
	+ by
	(
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	- )
	-
	-lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_coprod_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'
	-
	-lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
	- "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- using cf_discrete_vdomain_vsubset_Vset
	- by (intro is_cat_obj_prodI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ intro
	+ is_tm_cat_limitI
	+ is_tm_cat_coneI
	+ is_ntcf_axioms
	+ cat_lim_ua_fo
	+ cat_cone_obj
	+ NTCod.cf_is_tm_functor_if_HomDom_finite_category[
	+ OF NTDom.HomDom.finite_category_axioms
	+ ]
	)

	-lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_prod_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'
	-
	-
	-subsubsection\<open>Universal property\<close>
	-
	-lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I A \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	- by
	+sublocale is_cat_finite_colimit \<subseteq> is_tm_cat_colimit
	+ by
	(
	- rule cat_lim_unique_cone'[
	- OF assms, unfolded the_cat_discrete_components(1)
	- ]
	- )
	-
	-lemma (in is_cat_obj_prod) cat_obj_prod_unique:
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
	- by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])
	-
	-lemma (in is_cat_obj_prod) cat_obj_prod_unique':
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>i\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	-proof-
	- interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(1))
	- show ?thesis
	- by
	- (
	- rule cat_lim_unique'[
	- OF \<pi>'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
	+ intro
	+ is_tm_cat_colimitI
	+ is_tm_cat_coconeI
	+ is_ntcf_axioms
	+ cat_colim_ua_of
	+ cat_cocone_obj
	+ NTDom.cf_is_tm_functor_if_HomDom_finite_category[
	+ OF NTDom.HomDom.finite_category_axioms
	]
	- )
	-qed
	-
	-lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
	- assumes "\<pi>' : :\<rightarrow>: I A \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e U' : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	- by
	- (
	- rule cat_colim_unique_cocone'[
	- OF assms, unfolded the_cat_discrete_components(1)
	- ]
	- )
	-
	-lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
	- assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> \<pi>' = ntcf_const (:\<^sub>C I) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	- by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])
	-
	-lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
	- assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	- by
	- (
	- rule cat_colim_unique'[
	- OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
	- ]
	)

	-lemma cat_obj_prod_ex_is_arr_isomorphism:
	- assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f"
	-proof-
	- interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism[
	- OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms
	- ]
	- )
	-qed
	-
	-lemma cat_obj_prod_ex_is_arr_isomorphism':
	- assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P"
	- and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	-proof-
	- interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism'[
	- OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms,
	- unfolded the_cat_discrete_components(1)
	- ]
	- )
	-qed
	-
	-lemma cat_obj_coprod_ex_is_arr_isomorphism:
	- assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C I) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	-proof-
	- interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism[
	- OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms
	- ]
	- )
	-qed
	-
	-lemma cat_obj_coprod_ex_is_arr_isomorphism':
	- assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'"
	- and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	-proof-
	- interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism'[
	- OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms,
	- unfolded the_cat_discrete_components(1)
	- ]
	- )
	-qed
	-


	-subsection\<open>Finite product and finite coproduct\<close>
	-
	-locale is_cat_finite_obj_prod = is_cat_obj_prod \<alpha> I A \<CC> P \<pi>
	- for \<alpha> I A \<CC> P \<pi> +
	- assumes cat_fin_obj_prod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>"
	-
	-syntax "_is_cat_finite_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_finite_obj_prod \<alpha> I A \<CC> P \<pi>"
	-
	-locale is_cat_finite_obj_coprod = is_cat_obj_coprod \<alpha> I A \<CC> U \<pi>
	- for \<alpha> I A \<CC> U \<pi> +
	- assumes cat_fin_obj_coprod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>"
	-
	-syntax "_is_cat_finite_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_finite_obj_coprod \<alpha> I A \<CC> U \<pi>"
	+subsection\<open>Creation of limits\<close>

	-lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
	- using cat_fin_obj_prod_index_in_\<omega> by auto
	-
	-sublocale is_cat_finite_obj_prod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
	- by (intro finite_categoryI')
	- (
	- auto
	- simp: NTDom.HomDom.category_axioms the_cat_discrete_components
	- intro!: cat_fin_obj_prod_index_vfinite
	- )

	-lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
	- "vfinite I"
	- using cat_fin_obj_coprod_index_in_\<omega> by auto
	+text\<open>See Chapter V-1 in \cite{mac_lane_categories_2010}.\<close>

	-sublocale is_cat_finite_obj_coprod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
	- by (intro finite_categoryI')
	+definition cf_creates_limits :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "cf_creates_limits \<alpha> \<GG> \<FF> =
	(
	- auto
	- simp: NTDom.HomDom.category_axioms the_cat_discrete_components
	- intro!: cat_fin_obj_coprod_index_vfinite
	- )
	+ \<forall>\<tau> b.
	+ \<tau> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomCod\<rparr> \<longrightarrow>
	+ (
	+ (
	+ \<exists>!\<sigma>a. \<exists>\<sigma> a. \<sigma>a = \<langle>\<sigma>, a\<rangle> \<and>
	+ \<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF>\<lparr>HomCod\<rparr> \<and>
	+ \<tau> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<and>
	+ b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
	+ ) \<and>
	+ (
	+ \<forall>\<sigma> a.
	+ \<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF>\<lparr>HomCod\<rparr> \<longrightarrow>
	+ \<tau> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<longrightarrow>
	+ b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<longrightarrow>
	+ \<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF>\<lparr>HomCod\<rparr>
	+ )
	+ )
	+ )"


	text\<open>Rules.\<close>

	-lemma (in is_cat_finite_obj_prod)
	- is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	- shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_finite_obj_prod_axioms)
	-
	-mk_ide rf
	- is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
	- \|intro is_cat_finite_obj_prodI\|
	- \|dest is_cat_finite_obj_prodD[dest]\|
	- \|elim is_cat_finite_obj_prodE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD
	-
	-lemma (in is_cat_finite_obj_coprod)
	- is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	- shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_finite_obj_coprod_axioms)
	-
	-mk_ide rf
	- is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
	- \|intro is_cat_finite_obj_coprodI\|
	- \|dest is_cat_finite_obj_coprodD[dest]\|
	- \|elim is_cat_finite_obj_coprodE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD
	-
	-
	-text\<open>Duality.\<close>
	+context
	+ fixes \<alpha> \<JJ> \<AA> \<BB> \<GG> \<FF>
	+ assumes \<FF>: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+begin

	-lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
	- "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_finite_obj_coprodI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps
	- cs_intro: cat_fin_obj_prod_index_in_\<omega> cat_cs_intros cat_op_intros
	- )
	-
	-lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_finite_obj_coprod_op)
	+interpretation \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> by (rule \<FF>)
	+interpretation \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule \<GG>)

	-lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'
	+mk_ide rf cf_creates_limits_def[
	+ where \<alpha>=\<alpha> and \<FF>=\<FF> and \<GG>=\<GG>, unfolded cat_cs_simps
	+ ]
	+ \|intro cf_creates_limitsI\|
	+ \|dest cf_creates_limitsD'\|
	+ \|elim cf_creates_limitsE'\|

	-lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
	- "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_finite_obj_prodI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps
	- cs_intro: cat_fin_obj_coprod_index_in_\<omega> cat_cs_intros cat_op_intros
	- )
	+end

	-lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_finite_obj_prod_op)
	+lemmas cf_creates_limitsD[dest!] = cf_creates_limitsD'[rotated 2]
	+ and cf_creates_limitsE[elim!] = cf_creates_limitsE'[rotated 2]

	-lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'
	+lemma cf_creates_limitsE'':
	+ assumes "cf_creates_limits \<alpha> \<GG> \<FF>"
	+ and "\<tau> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ obtains \<sigma> r where "\<sigma> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and "\<tau> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>"
	+ and "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+proof-
	+ note cflD = cf_creates_limitsD[OF assms]
	+ from conjunct1[OF cflD] obtain \<sigma> r
	+ where \<sigma>: "\<sigma> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and \<tau>_def: "\<tau> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma>"
	+ and b_def: "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by metis
	+ moreover have "\<sigma> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by (rule conjunct2[OF cflD, rule_format, OF \<sigma> \<tau>_def b_def])
	+ ultimately show ?thesis using that by auto
	+qed



	-subsection\<open>Product and coproduct of two objects\<close>
	+subsection\<open>Preservation of limits and colimits\<close>


	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-locale is_cat_obj_prod_2 = is_cat_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	- for \<alpha> a b \<CC> P \<pi>
	-
	-syntax "_is_cat_obj_prod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {_,_} :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi>"
	+subsubsection\<open>Definitions and elementary properties\<close>

	-locale is_cat_obj_coprod_2 = is_cat_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	- for \<alpha> a b \<CC> P \<pi>

	-syntax "_is_cat_obj_coprod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ {_,_} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> _ :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	-translations "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi>"
	+text\<open>See Chapter V-4 in \cite{mac_lane_categories_2010}.\<close>

	-abbreviation proj_fst where "proj_fst \<pi> \<equiv> vpfst (\<pi>\<lparr>NTMap\<rparr>)"
	-abbreviation proj_snd where "proj_snd \<pi> \<equiv> vpsnd (\<pi>\<lparr>NTMap\<rparr>)"
	+definition cf_preserves_limits :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "cf_preserves_limits \<alpha> \<GG> \<FF> =
	+ (
	+ \<forall>\<sigma> a.
	+ \<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF>\<lparr>HomCod\<rparr> \<longrightarrow>
	+ \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomCod\<rparr>
	+ )"
	+
	+definition cf_preserves_colimits :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "cf_preserves_colimits \<alpha> \<GG> \<FF> =
	+ (
	+ \<forall>\<sigma> a.
	+ \<sigma> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m a : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF>\<lparr>HomCod\<rparr> \<longrightarrow>
	+ \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomCod\<rparr>
	+ )"


	text\<open>Rules.\<close>

	-lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>"
	- shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a',b'} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_prod_2_axioms)
	-
	-mk_ide rf is_cat_obj_prod_2_def
	- \|intro is_cat_obj_prod_2I\|
	- \|dest is_cat_obj_prod_2D[dest]\|
	- \|elim is_cat_obj_prod_2E[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D
	-
	-lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>"
	- shows "\<pi> : {a',b'} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_coprod_2_axioms)
	-
	-mk_ide rf is_cat_obj_coprod_2_def
	- \|intro is_cat_obj_coprod_2I\|
	- \|dest is_cat_obj_coprod_2D[dest]\|
	- \|elim is_cat_obj_coprod_2E[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
	- "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])
	-
	-lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_coprod_2_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'
	-
	-lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
	- "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])
	-
	-lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_prod_2_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'
	-
	-
	-text\<open>Product/coproduct of two objects is a finite product/coproduct.\<close>
	-
	-sublocale is_cat_obj_prod_2 \<subseteq> is_cat_finite_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	-proof(intro is_cat_finite_obj_prodI)
	- show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	-qed (cs_concl cs_shallow cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
	-
	-sublocale is_cat_obj_coprod_2 \<subseteq> is_cat_finite_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	-proof(intro is_cat_finite_obj_coprodI)
	- show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	-qed (cs_concl cs_shallow cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
	- shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	-proof-
	- have 0: "0 \<in>\<^sub>\<circ> 2\<^sub>\<nat>" and 1: "1\<^sub>\<nat> \<in>\<^sub>\<circ> 2\<^sub>\<nat>" by simp_all
	- show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- by
	- (
	- intro
	- cf_discrete_selector_vrange[OF 0, simplified]
	- cf_discrete_selector_vrange[OF 1, simplified]
	- )+
	-qed
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj
	-
	-lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
	- shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- by
	- (
	- intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
	- OF is_cat_obj_prod_2_op, unfolded cat_op_simps
	- ]
	- )+
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj
	-
	-
	-text\<open>Utilities/help lemmas.\<close>
	-
	-lemma helper_I2_proj_fst_proj_snd_iff:
	- "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<longleftrightarrow>
	- (proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and> proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	- unfolding two by auto
	-
	-lemma helper_I2_proj_fst_proj_snd_iff':
	- "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>) \<longleftrightarrow>
	- (proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and> proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>)"
	- unfolding two by auto
	-
	-
	-subsubsection\<open>Universal property\<close>
	-
	-lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows
	- "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	- proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	- proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by
	- (
	- rule cat_obj_prod_unique_cone'[
	- OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
	- ]
	- )
	-
	-lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f'"
	- by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])
	+context
	+ fixes \<alpha> \<JJ> \<AA> \<BB> \<GG> \<FF>
	+ assumes \<FF>: "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+begin

	-lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
	- assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows
	- "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	- proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	- proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by
	- (
	- rule cat_obj_prod_unique'[
	- OF is_cat_obj_prod_2D[OF assms],
	- unfolded helper_I2_proj_fst_proj_snd_iff
	- ]
	- )
	-
	-lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
	- assumes "\<pi>' : :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e P' : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows
	- "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
	- proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
	- proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
	- by
	- (
	- rule cat_obj_coprod_unique_cocone'[
	- OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
	- ]
	- )
	-
	-lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
	- assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and> \<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	- by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])
	-
	-lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
	- assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows
	- "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
	- proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
	- proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
	- by
	- (
	- rule cat_obj_coprod_unique'[
	- OF is_cat_obj_coprod_2D[OF assms],
	- unfolded helper_I2_proj_fst_proj_snd_iff'
	- ]
	- )
	-
	-lemma cat_obj_prod_2_ex_is_arr_isomorphism:
	- assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f"
	-proof-
	- interpret \<pi>: is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_prod_2 \<alpha> a b \<CC> P' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_obj_prod_ex_is_arr_isomorphism[
	- OF \<pi>.is_cat_obj_prod_axioms \<pi>'.is_cat_obj_prod_axioms
	- ]
	- )
	-qed
	+interpretation \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> by (rule \<FF>)
	+interpretation \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule \<GG>)

	-lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
	- assumes "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	-proof-
	- interpret \<pi>: is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi> by (rule assms(1))
	- interpret \<pi>': is_cat_obj_coprod_2 \<alpha> a b \<CC> U' \<pi>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_obj_coprod_ex_is_arr_isomorphism[
	- OF \<pi>.is_cat_obj_coprod_axioms \<pi>'.is_cat_obj_coprod_axioms
	- ]
	- )
	-qed
	-
	-
	-
	-subsection\<open>Pullbacks and pushouts\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-
	-text\<open>
	-The definitions and the elementary properties of the pullbacks and the
	-pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in
	-\cite{mac_lane_categories_2010}.
	-\<close>
	-
	-locale is_cat_pullback =
	- is_cat_limit \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x +
	- cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
	- for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x
	-
	-syntax "_is_cat_pullback" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b _\<rightarrow>_\<rightarrow>_\<leftarrow>_\<leftarrow>_ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
	-translations "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
	-
	-locale is_cat_pushout =
	- is_cat_colimit \<alpha> \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x +
	- cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
	- for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x
	+mk_ide rf cf_preserves_limits_def[
	+ where \<alpha>=\<alpha> and \<FF>=\<FF> and \<GG>=\<GG>, unfolded cat_cs_simps
	+ ]
	+ \|intro cf_preserves_limitsI\|
	+ \|dest cf_preserves_limitsD'\|
	+ \|elim cf_preserves_limitsE'\|

	-syntax "_is_cat_pushout" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _\<leftarrow>_\<leftarrow>_\<rightarrow>_\<rightarrow>_ >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
	-translations "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "\<aa>' = \<aa>"
	- and "\<gg>' = \<gg>"
	- and "\<oo>' = \<oo>"
	- and "\<ff>' = \<ff>"
	- and "\<bb>' = \<bb>"
	- and "\<CC>' = \<CC>"
	- and "X' = X"
	- shows "x : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>'\<rightarrow>\<gg>'\<rightarrow>\<oo>'\<leftarrow>\<ff>'\<leftarrow>\<bb>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_pullback_axioms)
	+mk_ide rf cf_preserves_colimits_def[
	+ where \<alpha>=\<alpha> and \<FF>=\<FF> and \<GG>=\<GG>, unfolded cat_cs_simps
	+ ]
	+ \|intro cf_preserves_colimitsI\|
	+ \|dest cf_preserves_colimitsD'\|
	+ \|elim cf_preserves_colimitsE'\|

	-mk_ide rf is_cat_pullback_def
	- \|intro is_cat_pullbackI\|
	- \|dest is_cat_pullbackD[dest]\|
	- \|elim is_cat_pullbackE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_pullbackD
	+end

	-lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "\<aa>' = \<aa>"
	- and "\<gg>' = \<gg>"
	- and "\<oo>' = \<oo>"
	- and "\<ff>' = \<ff>"
	- and "\<bb>' = \<bb>"
	- and "\<CC>' = \<CC>"
	- and "X' = X"
	- shows "x : \<aa>'\<leftarrow>\<gg>'\<leftarrow>\<oo>'\<rightarrow>\<ff>'\<rightarrow>\<bb>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_pushout_axioms)
	+lemmas cf_preserves_limitsD[dest!] = cf_preserves_limitsD'[rotated 2]
	+ and cf_preserves_limitsE[elim!] = cf_preserves_limitsE'[rotated 2]

	-mk_ide rf is_cat_pushout_def
	- \|intro is_cat_pushoutI\|
	- \|dest is_cat_pushoutD[dest]\|
	- \|elim is_cat_pushoutE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_pushoutD
	+lemmas cf_preserves_colimitsD[dest!] = cf_preserves_colimitsD'[rotated 2]
	+ and cf_preserves_colimitsE[elim!] = cf_preserves_colimitsE'[rotated 2]


	text\<open>Duality.\<close>

	-lemma (in is_cat_pullback) is_cat_pushout_op:
	- "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_pushoutI)
	- (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+
	-
	-lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_pushout_op)
	-
	-lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'
	-
	-lemma (in is_cat_pushout) is_cat_pullback_op:
	- "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_pullbackI)
	- (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+
	-
	-lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_pullback_op)
	-
	-lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-lemma cat_cone_cospan:
	- assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	- shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	-proof-
	- interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	- by (rule assms(1))
	- interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	- have \<gg>\<^sub>S\<^sub>S: "\<gg>\<^sub>S\<^sub>S : \<aa>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S" and \<ff>\<^sub>S\<^sub>S: "\<ff>\<^sub>S\<^sub>S : \<bb>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S"
	- by (cs_concl cs_intro: cat_ss_cs_intros)+
	- from x.ntcf_Comp_commute[OF \<gg>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show
	- "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	- )
	- moreover from x.ntcf_Comp_commute[OF \<ff>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show
	- "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	- )
	- ultimately show "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>" by simp
	-qed
	-
	-lemma (in is_cat_pullback) cat_pb_cone_cospan:
	- shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- by (all\<open>rule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]\<close>)
	-
	-lemma cat_cocone_span:
	- assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	- shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	-proof-
	- interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	- by (rule assms(1))
	- interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	- note op =
	- cat_cone_cospan
	- [
	- OF
	- x.is_cat_cone_op[unfolded cat_op_simps]
	- span.cf_scospan_op,
	- unfolded cat_op_simps
	- ]
	- from op(1) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- by
	- (
	- cs_prems
	- cs_simp: cat_ss_cs_simps cat_op_simps
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )
	- moreover from op(2) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- by
	- (
	- cs_prems
	- cs_simp: cat_ss_cs_simps cat_op_simps
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )
	- ultimately show "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>" by auto
	-qed
	-
	-lemma (in is_cat_pushout) cat_po_cocone_span:
	- shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- by (all\<open>rule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]\<close>)
	-
	-
	-subsubsection\<open>Universal property\<close>
	+lemma cf_preserves_colimits_op[cat_op_simps]:
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows
	+ "cf_preserves_colimits \<alpha> (op_cf \<GG>) (op_cf \<FF>) \<longleftrightarrow>
	+ cf_preserves_limits \<alpha> \<GG> \<FF>"
	+proof

	-lemma is_cat_pullbackI':
	- assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	- and "\<And>x' X'.
	- x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'.
	- f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- shows "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof(intro is_cat_pullbackI is_cat_limitI)
	-
	- show "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule assms(1))
	- interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	- by (rule assms(1))
	- show "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>" by (rule assms(2))
	- interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	-
	- fix u' r' assume prems:
	- "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-
	- interpret u': is_cat_cone \<alpha> r' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> u'
	- by (rule prems)
	-
	- from assms(3)[OF prems] obtain f'
	- where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	- and u'_\<aa>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- and u'_\<bb>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- and unique_f': "\<And>f''.
	- \<lbrakk>
	- f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X;
	- u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'';
	- u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	- \<rbrakk> \<Longrightarrow> f'' = f'"
	- by metis
	-
	- show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	- proof(intro ex1I conjI; (elim conjE)?)
	+ interpret \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(2))

	- show "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	- proof(rule ntcf_eqI)
	- show "u' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule u'.is_ntcf_axioms)
	- from f' show
	- "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f' :
	- cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
	- \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from f' have dom_rhs:
	- "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "u'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
	- fix a assume prems': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- from this f' x.is_ntcf_axioms show
	- "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by (elim the_cat_scospan_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps cat_ss_cs_simps
	- u'_\<bb>\<^sub>S\<^sub>S u'_\<aa>\<^sub>S\<^sub>S
	- cat_cone_cospan(1)[OF assms(1,2)]
	- cat_cone_cospan(1)[OF prems assms(2)]
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )+
	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros \| auto)+
	- qed simp_all
	-
	- fix f'' assume prems:
	- "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X" "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
	- have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- by (cs_concl cs_intro: cat_ss_cs_intros)+
	- have "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
	- proof-
	- from prems(2) have
	- "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by simp
	- from this that prems(1) show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed
	- from unique_f'[OF prems(1) this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S]] show "f'' = f'".
	-
	- qed (intro f')
	-
	-qed
	-
	-lemma is_cat_pushoutI':
	- assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	- and "\<And>x' X'. x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'.
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- shows "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	- by (rule assms(1))
	- interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	- have assms_3':
	- "\<exists>!f'.
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	- if "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- for x' X'
	- proof-
	- from that(1) have [cat_op_simps]:
	- "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- for f'
	- by (intro iffI conjI; (elim conjE)?)
	- (
	- cs_concl
	- cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )+
	- interpret x':
	- is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<open>op_cat \<CC>\<close> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<close> x'
	- by (rule that)
	- show ?thesis
	- unfolding cat_op_simps
	+ show "cf_preserves_limits \<alpha> \<GG> \<FF>"
	+ if "cf_preserves_colimits \<alpha> (op_cf \<GG>) (op_cf \<FF>)"
	+ proof(rule cf_preserves_limitsI, rule assms(1), rule assms(2))
	+ fix \<sigma> r assume "\<sigma> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<sigma>: is_cat_limit \<alpha> \<JJ> \<AA> \<FF> r \<sigma> .
	+ show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	- rule assms(3)[
	- OF x'.is_cat_cocone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps
	+ rule is_cat_colimit.is_cat_limit_op
	+ [
	+ OF cf_preserves_colimitsD
	+ [
	+ OF that \<sigma>.is_cat_colimit_op \<FF>.is_functor_op \<GG>.is_functor_op,
	+ folded op_cf_cf_comp op_ntcf_cf_ntcf_comp
	+ ],
	+ unfolded cat_op_simps
	]
	)
	qed
	- interpret op_x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<open>op_cat \<CC>\<close> X \<open>op_ntcf x\<close>
	- using
	- is_cat_pullbackI'
	- [
	- OF x.is_cat_cone_op[unfolded cat_op_simps]
	- span.cf_scospan_op,
	- unfolded cat_op_simps,
	- OF assms_3'
	- ]
	- by simp
	- show "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
	-qed
	-
	-lemma (in is_cat_pullback) cat_pb_unique_cone:
	- assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	- interpret x': is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x'
	- by (rule assms)
	- from cat_lim_ua_fo[OF assms] obtain f'
	- where f': "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	- and x'_def: "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	- and unique_f': "\<And>f''.
	- \<lbrakk> f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X; x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' \<rbrakk> \<Longrightarrow>
	- f'' = f'"
	- by auto
	- have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- by (cs_concl cs_intro: cat_ss_cs_intros)+
	- show ?thesis
	- proof(intro ex1I conjI; (elim conjE)?)
	- show "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X" by (rule f')
	- have "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
	- proof-
	- from x'_def have
	- "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by simp
	- from this that f' show "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed
	- from this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S] show
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by auto
	- fix f'' assume prems':
	- "f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- have "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
	- proof(rule ntcf_eqI)
	- show "x' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule x'.is_ntcf_axioms)
	- from prems'(1) show
	- "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' :
	- cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
	- \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- have dom_lhs: "\<D>\<^sub>\<circ> (x'\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	- from prems'(1) have dom_rhs:
	- "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "x'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix a assume prems'': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	- from this prems'(1) show
	- "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by (elim the_cat_scospan_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp:
	- prems'(2,3)
	- cat_cone_cospan(1,2)[OF assms cf_scospan_axioms]
	- cat_pb_cone_cospan
	- cat_ss_cs_simps cat_cs_simps
	- cs_intro: cat_ss_cs_intros cat_cs_intros
	- )+
	- qed (auto simp: cat_cs_intros)
	- qed simp_all
	- from unique_f'[OF prems'(1) this] show "f'' = f'".
	- qed
	-qed
	-
	-lemma (in is_cat_pullback) cat_pb_unique:
	- assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	- by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])
	-
	-lemma (in is_cat_pullback) cat_pb_unique':
	- assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	- interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
	- show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
	-qed
	-
	-lemma (in is_cat_pushout) cat_po_unique_cocone:
	- assumes "x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	-proof-
	- interpret x': is_cat_cocone \<alpha> X' \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x'
	- by (rule assms(1))
	- have [cat_op_simps]:
	- "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- for f'
	- by (intro iffI conjI; (elim conjE)?)
	- (
	- cs_concl
	- cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )+
	- show ?thesis
	- by
	- (
	- rule is_cat_pullback.cat_pb_unique_cone[
	- OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_pushout) cat_po_unique:
	- assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and> x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
	- by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])
	-
	-lemma (in is_cat_pushout) cat_po_unique':
	- assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	- x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	-proof-
	- interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
	- show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
	-qed
	-
	-lemma cat_pullback_ex_is_arr_isomorphism:
	- assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	- and "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f"
	-proof-
	- interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	- interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism[
	- OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
	- ]
	- )
	-qed

	-lemma cat_pullback_ex_is_arr_isomorphism':
	- assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	- and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	-proof-
	- interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	- interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	- obtain f where f: "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	- and "j \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism'[
	- OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
	- ]
	- )
	- then have
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- by (auto simp: cat_ss_cs_intros)
	- with f show ?thesis using that by simp
	-qed
	-
	-lemma cat_pushout_ex_is_arr_isomorphism:
	- assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	- and "x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
	-proof-
	- interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	- interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism[
	- OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
	- ]
	- )
	-qed
	-
	-lemma cat_pushout_ex_is_arr_isomorphism':
	- assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	- and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	- and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	-proof-
	- interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	- interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	- obtain f where f: "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	- and "j \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism'[
	- OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
	- unfolded the_cat_parallel_components(1)
	- ]
	- )
	- then have "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	- and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	- by (auto simp: cat_ss_cs_intros)
	- with f show ?thesis using that by simp
	-qed
	-
	-
	-
	-subsection\<open>Equalizers and coequalizers\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-
	-text\<open>
	-See \cite{noauthor_wikipedia_2001}\footnote{
	-\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
	-}.
	-\<close>
	-
	-locale is_cat_equalizer =
	- is_cat_limit \<alpha> \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close> \<CC> \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close> E \<epsilon> +
	- F': vsv F'
	- for \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> +
	- assumes cat_eq_F_in_Vset[cat_lim_cs_intros]: "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and cat_eq_F_ne[cat_lim_cs_intros]: "F \<noteq> 0"
	- and cat_eq_F'_vdomain[cat_lim_cs_simps]: "\<D>\<^sub>\<circ> F' = F"
	- and cat_eq_F'_app_is_arr[cat_lim_cs_intros]: "\<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	-
	-syntax "_is_cat_equalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q '(_,_,_,_') :/ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	-translations "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon>"
	-
	-locale is_cat_coequalizer =
	- is_cat_colimit \<alpha> \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close> \<CC> \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close> E \<epsilon> +
	- F': vsv F'
	- for \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> +
	- assumes cat_coeq_F_in_Vset[cat_lim_cs_intros]: "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and cat_coeq_F_ne[cat_lim_cs_intros]: "F \<noteq> 0"
	- and cat_coeq_F'_vdomain[cat_lim_cs_simps]: "\<D>\<^sub>\<circ> F' = F"
	- and cat_coeq_F'_app_is_arr[cat_lim_cs_intros]: "\<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	-
	-syntax "_is_cat_coequalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ '(_,_,_,_') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q _ :/ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	-translations "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon>"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "E' = E"
	- and "\<aa>' = \<aa>"
	- and "\<bb>' = \<bb>"
	- and "F'' = F"
	- and "F''' = F'"
	- and "\<CC>' = \<CC>"
	- shows "\<epsilon> : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>',\<bb>',F'',F''') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_equalizer_axioms)
	-
	-mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
	- \|intro is_cat_equalizerI\|
	- \|dest is_cat_equalizerD[dest]\|
	- \|elim is_cat_equalizerE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)
	-
	-lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "E' = E"
	- and "\<aa>' = \<aa>"
	- and "\<bb>' = \<bb>"
	- and "F'' = F"
	- and "F''' = F'"
	- and "\<CC>' = \<CC>"
	- shows "\<epsilon> : (\<aa>',\<bb>',F'',F''') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_coequalizer_axioms)
	-
	-mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
	- \|intro is_cat_coequalizerI\|
	- \|dest is_cat_coequalizerD[dest]\|
	- \|elim is_cat_coequalizerE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-lemma (in is_cat_equalizer)
	- cat_eq_\<aa>[cat_lim_cs_intros]: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and cat_eq_\<bb>[cat_lim_cs_intros]: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	-proof-
	- from cat_eq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	- have "F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" by (rule cat_eq_F'_app_is_arr[OF \<ff>])
	- then show "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	-qed
	-
	-lemma (in is_cat_coequalizer)
	- cat_coeq_\<aa>[cat_lim_cs_intros]: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and cat_coeq_\<bb>[cat_lim_cs_intros]: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	-proof-
	- from cat_coeq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	- have "F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" by (rule cat_coeq_F'_app_is_arr[OF \<ff>])
	- then show "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	-qed
	-
	-sublocale is_cat_equalizer \<subseteq> cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	- by (intro cf_parallelI cat_parallelI)
	+ show "cf_preserves_colimits \<alpha> (op_cf \<GG>) (op_cf \<FF>)"
	+ if "cf_preserves_limits \<alpha> \<GG> \<FF>"
	+ proof
	(
	- auto simp:
	- cat_lim_cs_simps cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	- )
	-
	-sublocale is_cat_coequalizer \<subseteq> cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	- by (intro cf_parallelI cat_parallelI)
	- (
	- auto simp:
	- cat_lim_cs_simps cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	+ rule cf_preserves_colimitsI,
	+ rule \<FF>.is_functor_op,
	+ rule \<GG>.is_functor_op,
	+ unfold cat_op_simps
	)
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_equalizer) is_cat_coequalizer_op:
	- "op_ntcf \<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_coequalizerI)
	- (
	- cs_concl
	- cs_simp: cat_lim_cs_simps cat_op_simps
	- cs_intro: V_cs_intros cat_op_intros cat_lim_cs_intros
	- )+
	-
	-lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_coequalizer_op)
	-
	-lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'
	-
	-lemma (in is_cat_coequalizer) is_cat_equalizer_op:
	- "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_equalizerI)
	- (
	- cs_concl
	- cs_simp: cat_lim_cs_simps cat_op_simps
	- cs_intro: V_cs_intros cat_op_intros cat_lim_cs_intros
	- )+
	-
	-lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_equalizer_op)
	-
	-lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'
	-
	-
	-text\<open>Further elementary properties.\<close>
	-
	-lemma (in category) cat_cf_parallel_\<aa>\<bb>:
	- assumes "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- shows "cf_parallel \<alpha> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' \<CC>"
	-proof-
	- have "\<aa>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (simp_all add: Axiom_of_Pairing \<bb>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L_def assms(2))
	- then show ?thesis
	- by (intro cf_parallelI cat_parallelI)
	- (
	- simp_all add:
	- assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	- )
	-qed
	-
	-lemma (in category) cat_cf_parallel_\<bb>\<aa>:
	- assumes "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- shows "cf_parallel \<alpha> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' \<CC>"
	-proof-
	- have "\<aa>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (simp_all add: Axiom_of_Pairing \<bb>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L_def assms(2))
	- then show ?thesis
	- by (intro cf_parallelI cat_parallelI)
	- (
	- simp_all add:
	- assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	- )
	-qed
	-
	-lemma cat_cone_cf_par_eps_NTMap_app:
	- assumes "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	- \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<ff> \<in>\<^sub>\<circ> F"
	- shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	-proof-
	- let ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close>
	- and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	- interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	- interpret par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	- by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<aa>\<bb> assms \<aa> \<bb>)
	- from assms(6) have \<ff>: "\<ff> : \<aa>\<^sub>P\<^sub>L F \<mapsto>\<^bsub>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<^esub> \<bb>\<^sub>P\<^sub>L F"
	- by (simp_all add: par.the_cat_parallel_is_arr_\<aa>\<bb>F)
	- from \<epsilon>.ntcf_Comp_commute[OF \<ff>] assms(6) show ?thesis
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_parallel_cs_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	-qed
	-
	-lemma cat_cocone_cf_par_eps_NTMap_app:
	- assumes "\<epsilon> :
	- \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	- \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<ff> \<in>\<^sub>\<circ> F"
	- shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	-proof-
	- let ?II = \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close>
	- and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close>
	- interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from assms(5,6)
	- have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and F'\<ff>: "F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- by auto
	- interpret par: cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	- by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<bb>\<aa> assms \<aa> \<bb>)
	- note \<epsilon>_NTMap_app =
	- cat_cone_cf_par_eps_NTMap_app[
	- OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps,
	- OF assms(2-6),
	- simplified
	- ]
	- from \<epsilon>_NTMap_app F'\<ff> show ?thesis
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric]
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	-qed
	-
	-lemma (in is_cat_equalizer) cat_eq_eps_NTMap_app:
	- assumes "\<ff> \<in>\<^sub>\<circ> F"
	- shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- by
	- (
	- intro cat_cone_cf_par_eps_NTMap_app[
	- OF
	- is_cat_cone_axioms
	- F'.vsv_axioms
	- cat_eq_F_in_Vset
	- cat_eq_F'_vdomain
	- cat_eq_F'_app_is_arr
	- assms
	- ]
	- )+
	-
	-lemma (in is_cat_coequalizer) cat_coeq_eps_NTMap_app:
	- assumes "\<ff> \<in>\<^sub>\<circ> F"
	- shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	- by
	- (
	- intro cat_cocone_cf_par_eps_NTMap_app[
	- OF is_cat_cocone_axioms
	- F'.vsv_axioms
	- cat_coeq_F_in_Vset
	- cat_coeq_F'_vdomain
	- cat_coeq_F'_app_is_arr
	- assms
	- ]
	- )+
	-
	-lemma (in is_cat_equalizer) cat_eq_Comp_eq:
	- assumes "\<gg> \<in>\<^sub>\<circ> F" and "\<ff> \<in>\<^sub>\<circ> F"
	- shows "F'\<lparr>\<gg>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- using
	- cat_eq_eps_NTMap_app[OF assms(1)] cat_eq_eps_NTMap_app[OF assms(2)]
	- by auto
	-
	-lemma (in is_cat_coequalizer) cat_coeq_Comp_eq:
	- assumes "\<gg> \<in>\<^sub>\<circ> F" and "\<ff> \<in>\<^sub>\<circ> F"
	- shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<gg>\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	- using cat_coeq_eps_NTMap_app[OF assms(1)] cat_coeq_eps_NTMap_app[OF assms(2)]
	- by auto
	-
	-
	-subsubsection\<open>Universal property\<close>
	-
	-lemma is_cat_equalizerI':
	- assumes "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	- \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<ff> \<in>\<^sub>\<circ> F"
	- and "\<And>\<epsilon>' E'. \<epsilon>' :
	- E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	- \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	-
	- let ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close> and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	- interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	- interpret par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	- by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<aa>\<bb> assms \<aa> \<bb>) simp
	-
	- show ?thesis
	- proof(intro is_cat_equalizerI is_cat_limitI assms(1-3))
	- fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- interpret u': is_cat_cone \<alpha> r' ?II \<CC> ?II_II u' by (rule prems)
	- from assms(7)[OF prems] obtain f'
	- where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- and u'_NTMap_app_\<aa>: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- and unique_f':
	- "\<And>f''.
	- \<lbrakk>
	- f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E;
	- u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	- \<rbrakk> \<Longrightarrow> f'' = f'"
	- by metis
	- show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	- proof(intro ex1I conjI; (elim conjE)?)
	- show "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	- proof(rule ntcf_eqI)
	- show "u' : cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule u'.is_ntcf_axioms)
	- from f' show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f' :
	- cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cat_ss_cs_simps
	- cs_intro: cat_cs_intros cat_ss_cs_intros
	- )
	- have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	- unfolding cat_cs_simps by simp
	- from f' have dom_rhs:
	- "\<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- show "u'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	- fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- note [cat_parallel_cs_simps] =
	- cat_cone_cf_par_eps_NTMap_app[
	- OF u'.is_cat_cone_axioms assms(2-5), simplified
	- ]
	- cat_cone_cf_par_eps_NTMap_app[OF assms(1-5), simplified]
	- u'_NTMap_app_\<aa>
	- from prems' f' assms(6) show
	- "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by (elim the_cat_parallel_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp: cat_parallel_cs_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- qed (cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros)+
	- qed simp_all
	- fix f'' assume prems'':
	- "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
	- from prems''(2) have u'_NTMap_a:
	- "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- for a
	- by simp
	- have "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- using u'_NTMap_a[of \<open>\<aa>\<^sub>P\<^sub>L F\<close>] prems''(1)
	- by
	- (
	- cs_prems
	- cs_simp: cat_parallel_cs_simps cat_cs_simps
	- cs_intro: cat_parallel_cs_intros cat_cs_intros
	- )
	- from unique_f'[OF prems''(1) this] show "f'' = f'".
	- qed (rule f')
	- qed (use assms in fastforce)+
	-
	-qed
	-
	-lemma is_cat_coequalizerI':
	- assumes "\<epsilon> :
	- \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	- \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "vsv F'"
	- and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	- and "\<D>\<^sub>\<circ> F' = F"
	- and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<ff> \<in>\<^sub>\<circ> F"
	- and "\<And>\<epsilon>' E'. \<epsilon>' :
	- \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	- \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- shows "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	-
	- let ?op_II = \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close>
	- and ?op_II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close>
	- and ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close>
	- and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	- interpret \<epsilon>: is_cat_cocone \<alpha> E ?op_II \<CC> ?op_II_II \<epsilon> by (rule assms(1))
	- from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	- interpret par: cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	- by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<bb>\<aa> assms \<aa> \<bb>) simp
	-
	- interpret op_par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<open>op_cat \<CC>\<close>
	- by (rule par.cf_parallel_op)
	- have assms_4':
	- "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	- if "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>" for \<epsilon>' E'
	- proof-
	- have [cat_op_simps]:
	- "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	- f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- for f'
	- by (intro iffI conjI; (elim conjE)?)
	- (
	- cs_concl cs_shallow
	- cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )+
	- interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<open>op_cat \<CC>\<close> ?II_II \<epsilon>' by (rule that)
	- show ?thesis
	- unfolding cat_op_simps
	+ fix \<sigma> r assume "\<sigma> : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	+ then interpret \<sigma>: is_cat_colimit \<alpha> \<open>op_cat \<JJ>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<FF>\<close> r \<sigma> .
	+ show "op_cf \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> :
	+ op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	by
	(
	- rule assms(7)[
	- OF \<epsilon>'.is_cat_cocone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps
	+ rule is_cat_limit.is_cat_colimit_op
	+ [
	+ OF cf_preserves_limitsD[
	+ OF that \<sigma>.is_cat_limit_op[unfolded cat_op_simps] assms(1,2)
	+ ],
	+ unfolded cat_op_simps
	]
	)
	qed
	- interpret op_\<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<open>op_cat \<CC>\<close> E \<open>op_ntcf \<epsilon>\<close>
	- by
	- (
	- rule
	- is_cat_equalizerI'
	- [
	- OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps,
	- OF assms(2-6) assms_4',
	- simplified
	- ]
	- )
	- show ?thesis by (rule op_\<epsilon>.is_cat_coequalizer_op[unfolded cat_op_simps])
	-
	-qed
	-
	-lemma (in is_cat_equalizer) cat_eq_unique_cone:
	- assumes "\<epsilon>' :
	- E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' : \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- (is \<open>\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	- shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	-
	- interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
	- from cat_lim_ua_fo[OF assms(1)] obtain f' where f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- and \<epsilon>'_def: "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	- and unique:
	- "\<lbrakk> f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' \<rbrakk> \<Longrightarrow> f'' = f'"
	- for f''
	- by auto
	- from cat_eq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	-
	- show ?thesis
	- proof(intro ex1I conjI; (elim conjE)?)
	- show f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" by (rule f')
	- from \<epsilon>'_def have "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- by simp
	- from this f' show \<epsilon>'_NTMap_app_I: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by
	- (
	- cs_prems
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- fix f'' assume prems:
	- "f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- have "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
	- proof(rule ntcf_eqI[OF ])
	- show "\<epsilon>' : cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (rule \<epsilon>'.is_ntcf_axioms)
	- from f' prems(1) show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' :
	- cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "\<epsilon>'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI, unfold cat_cs_simps)
	- show "vsv ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	- from prems(1) show
	- "?II\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- note [cat_cs_simps] =
	- cat_eq_eps_NTMap_app[OF \<ff>]
	- cat_cone_cf_par_eps_NTMap_app
	- [
	- OF
	- \<epsilon>'.is_cat_cone_axioms
	- F'.vsv_axioms
	- cat_eq_F_in_Vset
	- cat_eq_F'_vdomain
	- cat_eq_F'_app_is_arr \<ff>,
	- simplified
	- ]
	- from prems' prems(1) \<ff> have [cat_cs_simps]:
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	- by (elim the_cat_parallel_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )+
	- from prems' prems show
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed auto
	- qed simp_all
	- from unique[OF prems(1) this] show "f'' = f'" .
	- qed

	qed

	-lemma (in is_cat_equalizer) cat_eq_unique:
	- assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+lemma cf_preserves_limits_op[cat_op_simps]:
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	shows
	- "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f'"
	- by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])
	-
	-lemma (in is_cat_equalizer) cat_eq_unique':
	- assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	- interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(1))
	- show ?thesis by (rule cat_eq_unique_cone[OF \<epsilon>'.is_cat_cone_axioms])
	-qed
	-
	-lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
	- assumes "\<epsilon>' :
	- \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- (is \<open>\<epsilon>' : ?II_II >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	- shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	-proof-
	- interpret \<epsilon>': is_cat_cocone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
	- have [cat_op_simps]:
	- "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	- f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- for f'
	- by (intro iffI conjI; (elim conjE)?)
	- (
	- cs_concl cs_shallow
	- cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )+
	- show ?thesis
	- by
	- (
	- rule is_cat_equalizer.cat_eq_unique_cone[
	- OF is_cat_equalizer_op \<epsilon>'.is_cat_cone_op[unfolded cat_op_simps],
	- unfolded cat_op_simps
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_coequalizer) cat_coeq_unique:
	- assumes "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>' = ntcf_const (\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	- by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])
	-
	-lemma (in is_cat_coequalizer) cat_coeq_unique':
	- assumes "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	-proof-
	- interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(1))
	- show ?thesis by (rule cat_coeq_unique_cocone[OF \<epsilon>'.is_cat_cocone_axioms])
	-qed
	+ "cf_preserves_limits \<alpha> (op_cf \<GG>) (op_cf \<FF>) \<longleftrightarrow>
	+ cf_preserves_colimits \<alpha> \<GG> \<FF>"
	+proof

	-lemma cat_equalizer_ex_is_arr_isomorphism:
	- assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	- and "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f"
	-proof-
	- interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism[
	- OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
	- ]
	- )
	-qed
	+ interpret \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> by (rule assms(1))
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(2))

	-lemma cat_equalizer_ex_is_arr_isomorphism':
	- assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	-proof-
	- interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	- obtain f where f: "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	- and "j \<in>\<^sub>\<circ> \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
	- by
	- (
	- elim cat_lim_ex_is_arr_isomorphism'[
	- OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
	- ]
	- )
	- then have
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- unfolding the_cat_parallel_components by auto
	- with f show ?thesis using that by simp
	-qed
	+ show "cf_preserves_colimits \<alpha> \<GG> \<FF>"
	+ if "cf_preserves_limits \<alpha> (op_cf \<GG>) (op_cf \<FF>)"
	+ proof(rule cf_preserves_colimitsI, rule assms(1), rule assms(2))
	+ fix \<sigma> r assume "\<sigma> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<sigma>: is_cat_colimit \<alpha> \<JJ> \<AA> \<FF> r \<sigma> .
	+ show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ rule is_cat_limit.is_cat_colimit_op
	+ [
	+ OF cf_preserves_limitsD
	+ [
	+ OF that \<sigma>.is_cat_limit_op \<FF>.is_functor_op \<GG>.is_functor_op,
	+ folded op_cf_cf_comp op_ntcf_cf_ntcf_comp
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+ qed

	-lemma cat_coequalizer_ex_is_arr_isomorphism:
	- assumes "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	- and "\<epsilon>' = ntcf_const (\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	-proof-
	- interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	- from that show ?thesis
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism[
	- OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
	- ]
	- )
	-qed
	-
	-lemma cat_coequalizer_ex_is_arr_isomorphism':
	- assumes "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr>"
	-proof-
	- interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	- obtain f where f: "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	- and "j \<in>\<^sub>\<circ> \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
	- by
	- (
	- elim cat_colim_ex_is_arr_isomorphism'[
	- OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
	- ]
	- )
	- then have
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr>"
	- unfolding the_cat_parallel_components by auto
	- with f show ?thesis using that by simp
	+ show "cf_preserves_limits \<alpha> (op_cf \<GG>) (op_cf \<FF>)"
	+ if "cf_preserves_colimits \<alpha> \<GG> \<FF>"
	+ proof
	+ (
	+ rule cf_preserves_limitsI,
	+ rule \<FF>.is_functor_op,
	+ rule \<GG>.is_functor_op,
	+ unfold cat_op_simps
	+ )
	+ fix \<sigma> r assume "\<sigma> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	+ then interpret \<sigma>: is_cat_limit \<alpha> \<open>op_cat \<JJ>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<FF>\<close> r \<sigma> .
	+ show "op_cf \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> :
	+ \<GG>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
	+ by
	+ (
	+ rule is_cat_colimit.is_cat_limit_op
	+ [
	+ OF cf_preserves_colimitsD[
	+ OF that \<sigma>.is_cat_colimit_op[unfolded cat_op_simps] assms(1,2)
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+ qed
	+
	qed


	subsubsection\<open>Further properties\<close>

	-lemma (in is_cat_equalizer) cat_eq_is_monic_arr:
	- \<comment>\<open>See subsection 3.3 in \cite{awodey_category_2010}.\<close>
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : E \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> \<aa>"
	-proof(intro is_monic_arrI)
	- show "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : E \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cat_parallel_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- fix f g a
	- assume prems:
	- "f : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- "g : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	- define \<epsilon>' where "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f"
	- from prems(1) have "\<epsilon>' :
	- a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	- \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding \<epsilon>'_def by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
	- from cat_eq_unique_cone[OF this] obtain f'
	- where f': "f' : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- and \<epsilon>'_\<aa>: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- and unique_f': "\<And>f''.
	- \<lbrakk> f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'' \<rbrakk> \<Longrightarrow>
	- f'' = f'"
	- by meson
	- from prems(1) have unique_f: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- unfolding \<epsilon>'_def
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- from prems(1) have unique_g: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	- unfolding \<epsilon>'_def
	- by
	- (
	- cs_concl
	- cs_simp: prems(3) cat_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- show "f = g"
	- by
	- (
	- rule unique_f'
	- [
	- OF prems(1) unique_f,
	- unfolded unique_f'[OF prems(2) unique_g, symmetric]
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_coequalizer) cat_coeq_is_epic_arr:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : \<aa> \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> E"
	- by
	- (
	- rule is_cat_equalizer.cat_eq_is_monic_arr[
	- OF is_cat_equalizer_op, unfolded cat_op_simps
	- ]
	- )
	-
	-
	-
	-subsection\<open>Equalizers and coequalizers for two arrows\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-
	-text\<open>
	-See \cite{noauthor_wikipedia_2001}\footnote{
	-\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
	-}.
	-\<close>
	-
	-locale is_cat_equalizer_2 =
	- is_cat_limit \<alpha> \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close> E \<epsilon>
	- for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
	- assumes cat_eq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and cat_eq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	-
	-syntax "_is_cat_equalizer_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q '(_,_,_,_') :/ \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	-translations "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
	-
	-locale is_cat_coequalizer_2 =
	- is_cat_colimit
	- \<alpha> \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close> E \<epsilon>
	- for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
	- assumes cat_coeq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and cat_coeq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	-
	-syntax "_is_cat_coequalizer_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ '(_,_,_,_') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q _ :/ \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	-translations "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_equalizer_2) is_cat_equalizer_2_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "E' = E"
	- and "\<aa>' = \<aa>"
	- and "\<bb>' = \<bb>"
	- and "\<gg>' = \<gg>"
	- and "\<ff>' = \<ff>"
	- and "\<CC>' = \<CC>"
	- shows "\<epsilon> : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>',\<bb>',\<gg>',\<ff>') : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_equalizer_2_axioms)
	-
	-mk_ide rf is_cat_equalizer_2_def[unfolded is_cat_equalizer_2_axioms_def]
	- \|intro is_cat_equalizer_2I\|
	- \|dest is_cat_equalizer_2D[dest]\|
	- \|elim is_cat_equalizer_2E[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_equalizer_2D(1)
	-
	-lemma (in is_cat_coequalizer_2) is_cat_coequalizer_2_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>"
	- and "E' = E"
	- and "\<aa>' = \<aa>"
	- and "\<bb>' = \<bb>"
	- and "\<gg>' = \<gg>"
	- and "\<ff>' = \<ff>"
	- and "\<CC>' = \<CC>"
	- shows "\<epsilon> : (\<aa>',\<bb>',\<gg>',\<ff>') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_coequalizer_2_axioms)
	-
	-mk_ide rf is_cat_coequalizer_2_def[unfolded is_cat_coequalizer_2_axioms_def]
	- \|intro is_cat_coequalizer_2I\|
	- \|dest is_cat_coequalizer_2D[dest]\|
	- \|elim is_cat_coequalizer_2E[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_coequalizer_2D(1)
	-
	-
	-text\<open>Helper lemmas.\<close>
	-
	-(FIXME)
	-lemma cat_eq_F'_helper:
	- "(\<lambda>f\<in>\<^sub>\<circ>set {\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L}. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>)) =
	- (\<lambda>f\<in>\<^sub>\<circ>set {\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))"
	- using cat_PL2_\<gg>\<ff> by (simp add: VLambda_vdoubleton)
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-sublocale is_cat_equalizer_2 \<subseteq> cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>
	- by (intro cf_parallel_2I cat_parallel_2I)
	- (simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)
	-
	-sublocale is_cat_coequalizer_2 \<subseteq> cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>
	- by (intro cf_parallel_2I cat_parallel_2I)
	- (
	- auto simp:
	- cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	- cat_PL2_ineq[symmetric]
	- )
	-
	-lemma (in is_cat_equalizer_2) cat_equalizer_2_is_cat_equalizer:
	- "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) :
	- \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- intro is_cat_equalizerI,
	- rule is_cat_limit_axioms[
	- unfolded the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- )
	- (auto simp: Limit_vdoubleton_in_VsetI cat_parallel_cs_intros)
	-
	-lemma (in is_cat_coequalizer_2) cat_coequalizer_2_is_cat_coequalizer:
	- "\<epsilon> :
	- (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E :
	- \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof
	- (
	- intro is_cat_coequalizerI,
	- fold the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- )
	- show "\<epsilon> :
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<bb> \<aa> \<gg> \<ff> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m E :
	- \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- subst the_cat_parallel_2_commute,
	- subst cf_parallel_2_the_cf_parallel_2_commute[symmetric]
	- )
	- (intro is_cat_colimit_axioms)
	-qed (auto simp: Limit_vdoubleton_in_VsetI cat_parallel_cs_intros)
	-
	-lemma cat_equalizer_is_cat_equalizer_2:
	- assumes "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) :
	- \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- interpret \<epsilon>: is_cat_equalizer
	- \<alpha> \<aa> \<bb> \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close> \<open>(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<close> \<CC> E \<epsilon>
	- by (rule assms)
	- have \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	- show ?thesis
	- using \<epsilon>.cat_eq_F'_app_is_arr[OF \<gg>\<^sub>P\<^sub>L] \<epsilon>.cat_eq_F'_app_is_arr[OF \<ff>\<^sub>P\<^sub>L]
	- by
	- (
	- intro
	- is_cat_equalizer_2I
	- \<epsilon>.is_cat_limit_axioms
	- [
	- folded
	- the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- )
	- (auto simp: cat_PL2_\<gg>\<ff>)
	-qed
	-
	-lemma cat_coequalizer_is_cat_coequalizer_2:
	- assumes "\<epsilon> :
	- (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E :
	- \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- interpret is_cat_coequalizer
	- \<alpha> \<aa> \<bb> \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close> \<open>(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<close> \<CC> E \<epsilon>
	- by (rule assms)
	- interpret cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<bb> \<aa> \<gg> \<ff> \<CC>
	- by
	- (
	- rule cf_parallel_is_cf_parallel_2[
	- OF cf_parallel_axioms cat_PL2_\<gg>\<ff>, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- )
	- show "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- intro is_cat_coequalizer_2I,
	- subst the_cat_parallel_2_commute,
	- subst cf_parallel_2_the_cf_parallel_2_commute[symmetric],
	- rule is_cat_colimit_axioms[
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cf_parallel_2_def
	- ]
	- )
	- (simp_all add: cf_parallel_\<ff>' cf_parallel_\<gg>')
	-qed
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_equalizer_2) is_cat_coequalizer_2_op:
	- "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- unfolding is_cat_equalizer_def
	- by
	- (
	- rule cat_coequalizer_is_cat_coequalizer_2
	- [
	- OF is_cat_equalizer.is_cat_coequalizer_op[
	- OF cat_equalizer_2_is_cat_equalizer
	- ]
	- ]
	- )
	-
	-lemma (in is_cat_equalizer_2) is_cat_coequalizer_2_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_coequalizer_2_op)
	-
	-lemmas [cat_op_intros] = is_cat_equalizer_2.is_cat_coequalizer_2_op'
	-
	-lemma (in is_cat_coequalizer_2) is_cat_equalizer_2_op:
	- "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- unfolding is_cat_coequalizer_def
	- by
	- (
	- rule cat_equalizer_is_cat_equalizer_2
	- [
	- OF is_cat_coequalizer.is_cat_equalizer_op[
	- OF cat_coequalizer_2_is_cat_coequalizer
	- ]
	- ]
	- )
	-
	-lemma (in is_cat_coequalizer_2) is_cat_equalizer_2_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_equalizer_2_op)
	-
	-lemmas [cat_op_intros] = is_cat_coequalizer_2.is_cat_equalizer_2_op'
	-
	-
	-text\<open>Further elementary properties.\<close>
	-
	-lemma (in category) cat_cf_parallel_2_cat_equalizer:
	- assumes "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- shows "cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>"
	- using assms
	- by (intro cf_parallel_2I cat_parallel_2I)
	- (auto simp: cat_parallel_cs_intros cat_cs_intros)
	-
	-lemma (in category) cat_cf_parallel_2_cat_coequalizer:
	- assumes "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- shows "cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>"
	- using assms
	- by (intro cf_parallel_2I cat_parallel_2I)
	- (simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL2_ineq[symmetric])
	-
	-lemma cat_cone_cf_par_2_eps_NTMap_app:
	- assumes "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- shows
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	-proof-
	- let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	- and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	- and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	- interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (intro Limit_vdoubleton_in_VsetI) auto
	- from assms(2,3) have
	- "(\<And>\<ff>'. \<ff>' \<in>\<^sub>\<circ> ?F \<Longrightarrow> (\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<lparr>\<ff>'\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>)"
	- by auto
	- note cat_cone_cf_par_eps_NTMap_app = cat_cone_cf_par_eps_NTMap_app
	- [
	- OF
	- assms(1)[
	- unfolded
	- the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ],
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def, OF _ \<gg>\<ff> _ this,
	- simplified
	- ]
	- from
	- cat_cone_cf_par_eps_NTMap_app[of \<gg>\<^sub>P\<^sub>L, simplified]
	- cat_cone_cf_par_eps_NTMap_app[of \<ff>\<^sub>P\<^sub>L, simplified]
	- cat_PL2_\<gg>\<ff>
	- show
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- by fastforce+
	-qed
	-
	-lemma cat_cocone_cf_par_2_eps_NTMap_app:
	- assumes "\<epsilon> :
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	- \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- shows
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	-proof-
	- let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close>
	- and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
	- and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	- have \<ff>\<gg>_\<gg>\<ff>: "{\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L} = {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	- interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (intro Limit_vdoubleton_in_VsetI) auto
	- from assms(2,3) have
	- "(\<And>\<ff>'. \<ff>' \<in>\<^sub>\<circ> ?F \<Longrightarrow> (\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>))\<lparr>\<ff>'\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>)"
	- by auto
	- note cat_cocone_cf_par_eps_NTMap_app = cat_cocone_cf_par_eps_NTMap_app
	- [
	- OF assms(1)
	- [
	- unfolded
	- the_cat_parallel_2_def
	- the_cf_parallel_2_def
	- \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- insert_commute,
	- unfolded \<ff>\<gg>_\<gg>\<ff>
	- ],
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF _ \<gg>\<ff> _ this,
	- simplified
	- ]
	- from
	- cat_cocone_cf_par_eps_NTMap_app[of \<gg>\<^sub>P\<^sub>L, simplified]
	- cat_cocone_cf_par_eps_NTMap_app[of \<ff>\<^sub>P\<^sub>L, simplified]
	- cat_PL2_\<gg>\<ff>
	- show
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- by fastforce+
	-qed
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_eps_NTMap_app:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	-proof-
	- have \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	- note cat_eq_eps_NTMap_app = is_cat_equalizer.cat_eq_eps_NTMap_app
	- [
	- OF cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- from cat_eq_eps_NTMap_app[OF \<gg>\<^sub>P\<^sub>L] cat_eq_eps_NTMap_app[OF \<ff>\<^sub>P\<^sub>L] cat_PL2_\<gg>\<ff> show
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- by auto
	-qed
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_eps_NTMap_app:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	-proof-
	- have \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	- note cat_eq_eps_NTMap_app = is_cat_coequalizer.cat_coeq_eps_NTMap_app
	- [
	- OF cat_coequalizer_2_is_cat_coequalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- from cat_eq_eps_NTMap_app[OF \<gg>\<^sub>P\<^sub>L] cat_eq_eps_NTMap_app[OF \<ff>\<^sub>P\<^sub>L] cat_PL2_\<gg>\<ff> show
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- by auto
	-qed
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_Comp_eq:
	- "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- "\<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_Comp_eq:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	- unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all
	-
	-
	-subsubsection\<open>Universal property\<close>
	-
	-lemma is_cat_equalizer_2I':
	- assumes "\<epsilon> :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<And>\<epsilon>' E'. \<epsilon>' :
	- E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	- \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	- and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	- and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	- interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (intro Limit_vdoubleton_in_VsetI) auto
	- from assms(2,3) have "(\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<lparr>\<ff>'\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- if "\<ff>' \<in>\<^sub>\<circ> ?F" for \<ff>'
	- using that by simp
	- note is_cat_equalizerI' = is_cat_equalizerI'
	- [
	- OF
	- assms(1)[
	- unfolded
	- the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	- ],
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF
	- _
	- \<gg>\<ff>
	- _
	- this
	- _
	- assms(4)[unfolded the_cf_parallel_2_def the_cat_parallel_2_def],
	- of \<gg>\<^sub>P\<^sub>L,
	- simplified
	- ]
	- show ?thesis by (rule cat_equalizer_is_cat_equalizer_2[OF is_cat_equalizerI'])
	-qed
	-
	-lemma is_cat_coequalizer_2I':
	- assumes "\<epsilon> :
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	- \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "\<And>\<epsilon>' E'. \<epsilon>' :
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	- \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	- \<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- shows "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close>
	- and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
	- and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	- have \<ff>\<gg>_\<gg>\<ff>: "{\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L} = {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	- interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	- from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (intro Limit_vdoubleton_in_VsetI) auto
	- from assms(2,3) have "(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>))\<lparr>\<ff>'\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- if "\<ff>' \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" for \<ff>'
	- using that by simp
	- note is_cat_coequalizerI'
	- [
	- OF assms(1)[
	- unfolded
	- the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def \<ff>\<gg>_\<gg>\<ff>
	- ],
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF
	- _
	- \<gg>\<ff>
	- _
	- this
	- _
	- assms(4)[unfolded the_cf_parallel_2_def the_cat_parallel_2_def \<ff>\<gg>_\<gg>\<ff>],
	- of \<gg>\<^sub>P\<^sub>L,
	- simplified
	- ]
	- with cat_PL2_\<gg>\<ff> have
	- "\<epsilon> : (\<aa>,\<bb>,?F,(\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (auto simp: VLambda_vdoubleton)
	- from cat_coequalizer_is_cat_coequalizer_2[OF this] show ?thesis by simp
	-qed
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_unique_cone:
	- assumes "\<epsilon>' :
	- E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	- \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- by
	- (
	- rule is_cat_equalizer.cat_eq_unique_cone
	- [
	- OF cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF assms[unfolded the_cf_parallel_2_def the_cat_parallel_2_def]
	- ]
	- )
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_unique:
	- assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows
	- "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f'"
	-proof-
	- interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	- show ?thesis
	- by
	- (
	- rule is_cat_equalizer.cat_eq_unique
	- [
	- OF cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	- folded the_cat_parallel_2_def
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_unique':
	- assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	-proof-
	- interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	- show ?thesis
	- by
	- (
	- rule is_cat_equalizer.cat_eq_unique'
	- [
	- OF cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	- folded the_cat_parallel_2_def
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_unique_cocone:
	- assumes "\<epsilon>' :
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	- \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- by
	- (
	- rule is_cat_coequalizer.cat_coeq_unique_cocone
	- [
	- OF cat_coequalizer_2_is_cat_coequalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def insert_commute,
	- OF assms[
	- unfolded
	- the_cf_parallel_2_def the_cat_parallel_2_def cat_eq_F'_helper
	- ]
	- ]
	- )
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_unique:
	- assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'.
	- f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and>
	- \<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	-proof-
	- interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	- show ?thesis
	- by
	- (
	- rule is_cat_coequalizer.cat_coeq_unique
	- [
	- OF cat_coequalizer_2_is_cat_coequalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	- folded the_cat_parallel_2_def the_cat_parallel_2_commute
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_unique':
	- assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	-proof-
	- interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	- show ?thesis
	- by
	- (
	- rule is_cat_coequalizer.cat_coeq_unique'
	- [
	- OF cat_coequalizer_2_is_cat_coequalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	- OF \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	- folded the_cat_parallel_2_def
	- ]
	- )
	-qed
	-
	-lemma cat_equalizer_2_ex_is_arr_isomorphism:
	- assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	- and "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f"
	-proof-
	- interpret \<epsilon>: is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	- show ?thesis
	- using that
	- by
	- (
	- rule cat_equalizer_ex_is_arr_isomorphism
	- [
	- OF
	- \<epsilon>.cat_equalizer_2_is_cat_equalizer
	- \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def
	- ]
	- )
	-qed
	-
	-lemma cat_equalizer_2_ex_is_arr_isomorphism':
	- assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	-proof-
	- interpret \<epsilon>: is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	- show ?thesis
	- using that
	- by
	- (
	- rule cat_equalizer_ex_is_arr_isomorphism'
	- [
	- OF
	- \<epsilon>.cat_equalizer_2_is_cat_equalizer
	- \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	- folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def
	- ]
	- )
	-qed
	-
	-lemma cat_coequalizer_2_ex_is_arr_isomorphism:
	- assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	- and "\<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	-proof-
	- interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	- show ?thesis
	- using that
	- by
	- (
	- rule cat_coequalizer_ex_is_arr_isomorphism
	- [
	- OF
	- \<epsilon>.cat_coequalizer_2_is_cat_coequalizer
	- \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	- folded
	- \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cat_parallel_2_commute
	- ]
	- )
	-qed
	-
	-lemma cat_coequalizer_2_ex_is_arr_isomorphism':
	- assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	- and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	-proof-
	- interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	- interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	- show ?thesis
	- using that
	- by
	- (
	- rule cat_coequalizer_ex_is_arr_isomorphism'
	- [
	- OF
	- \<epsilon>.cat_coequalizer_2_is_cat_coequalizer
	- \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	- folded
	- \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cat_parallel_2_commute
	- ]
	- )
	-qed
	-
	-
	-subsubsection\<open>Further properties\<close>
	-
	-lemma (in is_cat_equalizer_2) cat_eq_2_is_monic_arr:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : E \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> \<aa>"
	- by
	- (
	- rule is_cat_equalizer.cat_eq_is_monic_arr[
	- OF cat_equalizer_2_is_cat_equalizer, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- )
	-
	-lemma (in is_cat_coequalizer_2) cat_coeq_2_is_epic_arr:
	- "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : \<aa> \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> E"
	- by
	- (
	- rule is_cat_coequalizer.cat_coeq_is_epic_arr[
	- OF cat_coequalizer_2_is_cat_coequalizer, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def
	- ]
	- )
	-
	-
	-
	-subsection\<open>Initial and terminal objects as limits/colimits of an empty diagram\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-text\<open>
	-See
	-\cite{noauthor_nlab_nodate}\footnote{
	-\url{https://ncatlab.org/nlab/show/initial+object}
	-}, \cite{noauthor_nlab_nodate}\footnote{
	-\url{https://ncatlab.org/nlab/show/terminal+object}
	-} and Chapter X-1 in \cite{mac_lane_categories_2010}.
	-\<close>
	-
	-locale is_cat_obj_empty_terminal = is_cat_limit \<alpha> cat_0 \<CC> \<open>cf_0 \<CC>\<close> z \<ZZ>
	- for \<alpha> \<CC> z \<ZZ>
	-
	-syntax "_is_cat_obj_empty_terminal" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F :/ 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51] 51)
	-translations "\<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_empty_terminal \<alpha> \<CC> z \<ZZ>"
	-
	-locale is_cat_obj_empty_initial = is_cat_colimit \<alpha> cat_0 \<CC> \<open>cf_0 \<CC>\<close> z \<ZZ>
	- for \<alpha> \<CC> z \<ZZ>
	-
	-syntax "_is_cat_obj_empty_initial" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	- (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F :/ 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51] 51)
	-translations "\<ZZ> : z >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	- "CONST is_cat_obj_empty_initial \<alpha> \<CC> z \<ZZ>"
	-
	-
	-text\<open>Rules.\<close>
	-
	-lemma (in is_cat_obj_empty_terminal)
	- is_cat_obj_empty_terminal_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	- shows "\<ZZ> : z' <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_empty_terminal_axioms)
	-
	-mk_ide rf is_cat_obj_empty_terminal_def
	- \|intro is_cat_obj_empty_terminalI\|
	- \|dest is_cat_obj_empty_terminalD[dest]\|
	- \|elim is_cat_obj_empty_terminalE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_empty_terminalD
	-
	-lemma (in is_cat_obj_empty_initial)
	- is_cat_obj_empty_initial_axioms'[cat_lim_cs_intros]:
	- assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	- shows "\<ZZ> : z' >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_empty_initial_axioms)
	-
	-mk_ide rf is_cat_obj_empty_initial_def
	- \|intro is_cat_obj_empty_initialI\|
	- \|dest is_cat_obj_empty_initialD[dest]\|
	- \|elim is_cat_obj_empty_initialE[elim]\|
	-
	-lemmas [cat_lim_cs_intros] = is_cat_obj_empty_initialD
	-
	-
	-text\<open>Duality.\<close>
	-
	-lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op:
	- "op_ntcf \<ZZ> : z >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_obj_empty_initialI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
	- )
	-
	-lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<ZZ> : z >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_empty_initial_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op'
	-
	-lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op:
	- "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- by (intro is_cat_obj_empty_terminalI)
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
	- )
	-
	-lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op'[cat_op_intros]:
	- assumes "\<CC>' = op_cat \<CC>"
	- shows "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	- unfolding assms by (rule is_cat_obj_empty_terminal_op)
	-
	-lemmas [cat_op_intros] = is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op'
	-
	-
	-text\<open>Elementary properties.\<close>
	-
	-lemma (in is_cat_obj_empty_terminal) cat_oet_ntcf_0: "\<ZZ> = ntcf_0 \<CC>"
	- by (rule is_ntcf_is_ntcf_0_if_cat_0)
	- (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	-lemma (in is_cat_obj_empty_initial) cat_oei_ntcf_0: "\<ZZ> = ntcf_0 \<CC>"
	- by (rule is_ntcf_is_ntcf_0_if_cat_0)
	- (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	-
	-subsubsection\<open>
	-Initial and terminal objects as limits are initial and terminal objects
	-\<close>
	-
	-lemma (in category) cat_obj_terminal_is_cat_obj_empty_terminal:
	- assumes "obj_terminal \<CC> z"
	- shows "ntcf_0 \<CC> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+lemma cf_preserves_limits_if_cf_creates_limits:
	+ \<comment>\<open>See Theorem 2 in Chapter V-4 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and "\<psi> : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ and "cf_creates_limits \<alpha> \<GG> \<FF>"
	+ shows "cf_preserves_limits \<alpha> \<GG> \<FF>"
	proof-

	- from assms have z: "z \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	- from z have [cat_cs_simps]: "cf_const cat_0 \<CC> z = cf_0 \<CC>"
	- by (intro is_functor_is_cf_0_if_cat_0) (cs_concl cs_intro: cat_cs_intros)
	- note obj_terminalD = obj_terminalD[OF assms]
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	+ interpret \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> by (rule assms(2))
	+ interpret \<psi>: is_cat_limit \<alpha> \<JJ> \<BB> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> b \<psi>
	+ by (intro is_cat_limit.cat_lim_is_tm_cat_limit assms(3,4))

	show ?thesis
	proof
	(
	- intro is_cat_obj_empty_terminalI is_cat_limitI is_cat_coneI,
	- unfold cat_cs_simps
	- )
	- show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z \<and> u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	- if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" for u' r'
	- proof-
	- interpret u': is_cat_cone \<alpha> r' cat_0 \<CC> \<open>cf_0 \<CC>\<close> u' by (rule that)
	- from z have [cat_cs_simps]: "cf_const cat_0 \<CC> r' = cf_0 \<CC>"
	- by (intro is_functor_is_cf_0_if_cat_0)
	- (cs_concl cs_shallow cs_intro: cat_cs_intros)
	- have u'_def: "u' = ntcf_0 \<CC>"
	- by
	- (
	- rule is_ntcf_is_ntcf_0_if_cat_0[
	- OF u'.is_ntcf_axioms, unfolded cat_cs_simps
	- ]
	- )
	- from obj_terminalD(2)[OF u'.cat_cone_obj] obtain f'
	- where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z"
	- and f'_unique: "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z \<Longrightarrow> f'' = f'"
	- for f''
	- by auto
	- from f' have [cat_cs_simps]: "ntcf_const cat_0 \<CC> f' = ntcf_0 \<CC>"
	- by (intro is_ntcf_is_ntcf_0_if_cat_0(1))
	- (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show ?thesis
	- proof(intro ex1I conjI; (elim conjE)?)
	- show "u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: u'_def cat_cs_simps cs_intro: cat_cs_intros
	- )
	- fix f'' assume prems:
	- "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z" "u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f''"
	- show "f'' = f'" by (rule f'_unique[OF prems(1)])
	- qed (rule f')
	- qed
	- qed (cs_concl cs_simp: cat_cs_simps cs_intro: z cat_cs_intros)
	-
	-qed
	-
	-lemma (in category) cat_obj_initial_is_cat_obj_empty_initial:
	- assumes "obj_initial \<CC> z"
	- shows "ntcf_0 \<CC> : z >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- have z: "obj_terminal (op_cat \<CC>) z" unfolding cat_op_simps by (rule assms)
	- show ?thesis
	- by
	- (
	- rule is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op
	- [
	- OF category.cat_obj_terminal_is_cat_obj_empty_terminal[
	- OF category_op z, folded op_ntcf_ntcf_0
	- ],
	- unfolded cat_op_simps op_ntcf_ntcf_0
	- ]
	- )
	-qed
	-
	-lemma (in is_cat_obj_empty_terminal) cat_oet_obj_terminal: "obj_terminal \<CC> z"
	-proof-
	- show "obj_terminal \<CC> z"
	- proof(rule obj_terminalI)
	- fix a assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- have [cat_cs_simps]: "cf_const cat_0 \<CC> a = cf_0 \<CC>"
	- by (rule is_functor_is_cf_0_if_cat_0)
	- (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros prems)
	- from prems have "ntcf_0 \<CC> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (intro is_cat_coneI)
	- (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from cat_lim_ua_fo[OF this] obtain f'
	- where f': "f' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	- and "ntcf_0 \<CC> = \<ZZ> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	- and f'_unique:
	- "\<lbrakk> f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> z; ntcf_0 \<CC> = \<ZZ> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'' \<rbrakk> \<Longrightarrow>
	- f'' = f'"
	- for f''
	- by metis
	- show "\<exists>!f'. f' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	- proof(intro ex1I)
	- fix f'' assume prems': "f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	- from prems' have "ntcf_0 \<CC> = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f''"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from f'_unique[OF prems', unfolded cat_oet_ntcf_0, OF this]
	- show "f'' = f'".
	- qed (rule f')
	- qed (rule cat_cone_obj)
	-qed
	-
	-lemma (in is_cat_obj_empty_initial) cat_oei_obj_initial: "obj_initial \<CC> z"
	- by
	- (
	- rule is_cat_obj_empty_terminal.cat_oet_obj_terminal[
	- OF is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op[
	- OF is_cat_obj_empty_initial_axioms
	- ],
	- unfolded cat_op_simps
	- ]
	+ intro cf_preserves_limitsI,
	+ rule \<FF>.is_functor_axioms,
	+ rule \<GG>.is_functor_axioms
	)

	-lemma (in category) cat_is_cat_obj_empty_terminal_obj_terminal_iff:
	- "(ntcf_0 \<CC> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_terminal \<CC> z"
	- using
	- cat_obj_terminal_is_cat_obj_empty_terminal
	- is_cat_obj_empty_terminal.cat_oet_obj_terminal
	- by auto
	-
	-lemma (in category) cat_is_cat_obj_empty_initial_obj_initial_iff:
	- "(ntcf_0 \<CC> : z >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_initial \<CC> z"
	- using
	- cat_obj_initial_is_cat_obj_empty_initial
	- is_cat_obj_empty_initial.cat_oei_obj_initial
	- by auto
	-
	-
	-
	-subsection\<open>Projection cone\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-definition ntcf_obj_prod_base :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	- where "ntcf_obj_prod_base \<CC> I F P f =
	- [(\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j), cf_const (:\<^sub>C I) \<CC> P, :\<rightarrow>: I F \<CC>, :\<^sub>C I, \<CC>]\<^sub>\<circ>"
	-
	-
	-text\<open>Components.\<close>
	-
	-lemma ntcf_obj_prod_base_components:
	- shows "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr> = (\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j)"
	- and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDom\<rparr> = cf_const (:\<^sub>C I) \<CC> P"
	- and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTCod\<rparr> = :\<rightarrow>: I F \<CC>"
	- and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	- and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGCod\<rparr> = \<CC>"
	- unfolding ntcf_obj_prod_base_def nt_field_simps
	- by (simp_all add: nat_omega_simps)
	-
	-
	-subsubsection\<open>Natural transformation map\<close>
	-
	-mk_VLambda ntcf_obj_prod_base_components(1)
	- \|vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]\|
	- \|vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]\|
	- \|app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]\|
	+ fix \<sigma> a assume prems: "\<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<sigma>: is_cat_limit \<alpha> \<JJ> \<AA> \<FF> a \<sigma> .

	-
	-subsubsection\<open>Projection natural transformation is a cone\<close>
	-
	-lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
	- assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
	- shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	- from assms(2) have [cat_cs_intros]:
	- "\<lbrakk> a \<in>\<^sub>\<circ> I; P' = P; Fa = F a \<rbrakk> \<Longrightarrow> f a : P' \<mapsto>\<^bsub>\<CC>\<^esub> Fa" for a P' Fa
	- by simp
	- show "vfsequence (ntcf_obj_prod_base \<CC> I F P f)"
	- unfolding ntcf_obj_prod_base_def by auto
	- show "vcard (ntcf_obj_prod_base \<CC> I F P f) = 5\<^sub>\<nat>"
	- unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
	- from assms show "cf_const (:\<^sub>C I) \<CC> P : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- cs_concl
	- cs_intro:
	- cf_discrete_vdomain_vsubset_Vset
	- cat_discrete_cs_intros
	- cat_cs_intros
	- )
	- show ":\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_intro: cat_discrete_cs_intros)
	- show "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	- cf_const (:\<^sub>C I) \<CC> P\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> :\<rightarrow>: I F \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- if "a \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>" for a
	- proof-
	- from that have "a \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
	- from that this show ?thesis
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
	- )
	- qed
	- show
	- "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	- cf_const (:\<^sub>C I) \<CC> P\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
	- :\<rightarrow>: I F \<CC>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- if "g : a \<mapsto>\<^bsub>:\<^sub>C I\<^esub> b" for a b g
	- proof-
	- note g = the_cat_discrete_is_arrD[OF that]
	- from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
	- unfolding g(7-9)
	+ obtain \<tau> A
	+ where \<tau>: "\<tau> : A <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ and \<psi>_def: "\<psi> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>"
	+ and b_def: "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
	by
	(
	- cs_concl
	- cs_simp: cat_cs_simps cat_discrete_cs_simps
	- cs_intro:
	- cf_discrete_vdomain_vsubset_Vset
	- cat_cs_intros cat_discrete_cs_intros
	+ rule cf_creates_limitsE''
	+ [
	+ OF
	+ assms(4)
	+ \<psi>.is_cat_limit_axioms
	+ \<FF>.is_functor_axioms
	+ \<GG>.is_functor_axioms
	+ ]
	)
	- qed
	-qed
	- (
	- auto simp:
	- assms
	- ntcf_obj_prod_base_components
	- tm_cf_discrete_the_cf_discrete_is_tm_functor
	- )
	-
	-lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
	- assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	- and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
	- and "\<And>u' r'.
	- \<lbrakk> u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow>
	- \<exists>!f'.
	- f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	- u' = ntcf_obj_prod_base \<CC> I F P f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
	- shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof
	- (
	- intro
	- is_cat_obj_prodI
	- is_cat_limitI
	- tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified]
	- assms(1,3)
	- )
	- show "cf_discrete \<alpha> I F \<CC>"
	- by (cs_concl cs_shallow cs_intro: cat_small_discrete_cs_intros)
	-qed
	-
	-
	-
	-subsection\<open>Equalizer cone\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	+ from \<tau> interpret \<tau>: is_cat_limit \<alpha> \<JJ> \<AA> \<FF> A \<tau> .

	-definition ntcf_equalizer_base :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	- where "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e =
	- [
	- (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x),
	- cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E,
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>,
	- \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L,
	- \<CC>
	- ]\<^sub>\<circ>"
	-
	-
	-text\<open>Components.\<close>
	-
	-lemma ntcf_equalizer_base_components:
	- shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr> =
	- (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x)"
	- and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDom\<rparr> =
	- cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E"
	- and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTCod\<rparr> =
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>"
	- and [cat_lim_cs_simps]:
	- "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGDom\<rparr> = \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L"
	- and [cat_lim_cs_simps]:
	- "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGCod\<rparr> = \<CC>"
	- unfolding ntcf_equalizer_base_def nt_field_simps
	- by (simp_all add: nat_omega_simps)
	-
	-
	-subsubsection\<open>Natural transformation map\<close>
	+ from cat_lim_ex_is_iso_arr[OF \<tau>.is_cat_limit_axioms prems] obtain f
	+ where f: "f : a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> A" and \<sigma>_def: "\<sigma> = \<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f"
	+ by auto

	-mk_VLambda ntcf_equalizer_base_components(1)
	- \|vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]\|
	- \|vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]\|
	- \|app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]\|
	-
	-
	-subsubsection\<open>Equalizer cone is a cone\<close>
	+ note f = f is_iso_arrD(1)[OF f]

	-lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
	- assumes "e \<aa>\<^sub>P\<^sub>L\<^sub>2 : E \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	- and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 : E \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L\<^sub>2"
	- and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L\<^sub>2"
	- and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	- shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e :
	- E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	- \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- interpret par: cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>
	- by (intro cf_parallel_2I cat_parallel_2I assms(5,6))
	- (simp_all add: cat_parallel_cs_intros cat_cs_intros)
	- show ?thesis
	- proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	- show "vfsequence (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e)"
	- unfolding ntcf_equalizer_base_def by auto
	- show "vcard (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e) = 5\<^sub>\<nat>"
	- unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
	- from assms(2) show
	- "cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ from f(2) have "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by (intro is_cat_coneI)
	+ (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+ from \<sigma>_def have "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<tau> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<AA> f)"
	+ by simp
	+ also from f(2) have "\<dots> = \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	+ by (cs_concl_step cf_ntcf_comp_ntcf_vcomp)
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps \<psi>_def[symmetric] cs_intro: cat_cs_intros
	+ )
	+ finally have \<GG>\<sigma>: "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> = \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)" .
	+
	+ show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	by
	(
	- cs_concl
	- cs_simp: cat_cs_simps
	- cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
	+ rule \<psi>.cat_lim_is_cat_limit_if_is_iso_arr
	+ [
	+ OF \<GG>.cf_ArrMap_is_iso_arr[OF f(1), folded b_def],
	+ folded \<GG>\<sigma>
	+ ]
	)
	- from assms show
	- "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_intro: cat_parallel_cs_intros cat_small_cs_intros)
	- show
	- "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>i\<rparr> :
	- cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>"
	- if "i \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>" for i
	- proof-
	- from that assms(1,2,5,6) show ?thesis
	- by (elim the_cat_parallel_2_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- qed
	- show
	- "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	- cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
	- \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	- ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
	- if "f' : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<^esub> b'" for a' b' f'
	- using that assms(1,2,5,6)
	- by (elim par.the_cat_parallel_2_is_arrE; simp only:)
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps
	- cat_lim_cs_simps
	- cat_parallel_cs_simps
	- assms(3,4)[symmetric]
	- cs_intro: cat_parallel_cs_intros
	- )+
	- qed
	- (
	- use assms(2) in
	- \<open>
	- cs_concl
	- cs_intro: cat_lim_cs_intros cat_cs_intros
	- cs_simp: cat_lim_cs_simps
	- \<close>
	- )+
	+
	+ qed
	+
	qed



	-subsection\<open>Limits by products and equalizers\<close>
	-
	-lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
	- \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
	- assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>; \<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb> \<rbrakk> \<Longrightarrow>
	- \<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
	- \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
	- \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains r u where "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	-
	- let ?L =\<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?R =\<open>\<lambda>i. \<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<close>
	-
	- interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
	-
	- have "?R j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros that)
	-
	- have "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
	- proof(intro tm_cf_discreteI)
	- show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros that)
	- show "VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- show "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof-
	- have "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	- by (auto simp: \<FF>.cf_ObjMap_vdomain)
	- moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (force intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
	- ultimately show ?thesis by auto
	- qed
	- qed (auto simp: cat_small_cs_intros)
	- show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof-
	- have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- proof(rule vrange_VLambda_vsubset)
	- fix x assume x: "x \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- then have "\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by (auto intro: cat_cs_intros simp: cat_cs_simps)
	- moreover from x have "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr>\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by (simp add: \<FF>.ArrMap.vsv_vimageI2)
	- qed
	- moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
	- ultimately show ?thesis by auto
	- qed
	- qed (auto simp: cat_small_cs_intros)
	- qed (auto intro: cat_cs_intros)
	-
	- from assms(3)[where A=\<open>?R\<close>, OF this] obtain P\<^sub>O \<pi>\<^sub>O
	- where \<pi>\<^sub>O: "\<pi>\<^sub>O : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?R : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by clarsimp
	-
	- interpret \<pi>\<^sub>O: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> ?R \<CC> P\<^sub>O \<pi>\<^sub>O by (rule \<pi>\<^sub>O)
	-
	- have P\<^sub>O: "P\<^sub>O \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro \<pi>\<^sub>O.cat_cone_obj)
	-
	- have "?L u \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "u \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for u
	- proof-
	- from that obtain a b where "u : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show ?thesis
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed
	+subsection\<open>Continuous and cocontinuous functor\<close>

	- have tm_cf_discrete: "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>"
	- proof(intro tm_cf_discreteI)
	- show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	- proof-
	- from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show ?thesis
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed
	-
	- show "(\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- show "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof-
	- have "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	- proof(rule vrange_VLambda_vsubset)
	- fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	- then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	- )
	- qed
	- moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (auto intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
	- ultimately show ?thesis by auto
	- qed
	- qed (auto simp: cat_small_cs_intros)

	- show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof-
	- have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- proof(rule vrange_VLambda_vsubset)
	- fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	- then obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then have "\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by (auto intro: cat_cs_intros simp: cat_cs_simps)
	- moreover from f have
	- "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by (simp add: \<FF>.ArrMap.vsv_vimageI2)
	- qed
	- moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
	- ultimately show ?thesis by auto
	- qed
	- qed (auto simp: cat_small_cs_intros)
	- qed (auto intro: cat_cs_intros)
	+subsubsection\<open>Definition and elementary properties\<close>

	- from assms(4)[where A=\<open>?L\<close>, OF this, simplified] obtain P\<^sub>A \<pi>\<^sub>A
	- where \<pi>\<^sub>A: "\<pi>\<^sub>A : P\<^sub>A <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?L : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by auto
	-
	- interpret \<pi>\<^sub>A: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> ?L \<CC> P\<^sub>A \<pi>\<^sub>A by (rule \<pi>\<^sub>A)
	-
	- let ?F = \<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?f = \<open>\<lambda>u. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	- let ?\<pi>\<^sub>O' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?f\<close>
	+definition is_cf_continuous :: "V \<Rightarrow> V \<Rightarrow> bool"
	+ where "is_cf_continuous \<alpha> \<GG> \<longleftrightarrow>
	+ (\<forall>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomDom\<rparr> \<longrightarrow> cf_preserves_limits \<alpha> \<GG> \<FF>)"

	- have \<pi>\<^sub>O': "?\<pi>\<^sub>O' :
	- P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) (\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<CC> :
	- :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding the_cat_discrete_components(1)
	- proof
	- (
	- intro
	- tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	- tm_cf_discrete
	- )
	- fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	- then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	+definition is_cf_cocontinuous :: "V \<Rightarrow> V \<Rightarrow> bool"
	+ where "is_cf_cocontinuous \<alpha> \<GG> \<longleftrightarrow>
	+ (\<forall>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomDom\<rparr> \<longrightarrow> cf_preserves_colimits \<alpha> \<GG> \<FF>)"
	+
	+
	+text\<open>Rules.\<close>
	+
	+context
	+ fixes \<alpha> \<JJ> \<AA> \<BB> \<GG> \<FF>
	+ assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+begin
	+
	+interpretation \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule \<GG>)
	+
	+mk_ide rf is_cf_continuous_def[where \<alpha>=\<alpha> and \<GG>=\<GG>, unfolded cat_cs_simps]
	+ \|intro is_cf_continuousI\|
	+ \|dest is_cf_continuousD'\|
	+ \|elim is_cf_continuousE'\|
	+
	+mk_ide rf is_cf_cocontinuous_def[where \<alpha>=\<alpha> and \<GG>=\<GG>, unfolded cat_cs_simps]
	+ \|intro is_cf_cocontinuousI\|
	+ \|dest is_cf_cocontinuousD'\|
	+ \|elim is_cf_cocontinuousE'\|
	+
	+end
	+
	+lemmas is_cf_continuousD[dest!] = is_cf_continuousD'[rotated]
	+ and is_cf_continuousE[elim!] = is_cf_continuousE'[rotated]
	+
	+lemmas is_cf_cocontinuousD[dest!] = is_cf_cocontinuousD'[rotated]
	+ and is_cf_cocontinuousE[elim!] = is_cf_cocontinuousE'[rotated]
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma is_cf_continuous_op[cat_op_simps]:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "is_cf_continuous \<alpha> (op_cf \<GG>) \<longleftrightarrow> is_cf_cocontinuous \<alpha> \<GG>"
	+proof
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	+ show "is_cf_cocontinuous \<alpha> \<GG>" if "is_cf_continuous \<alpha> (op_cf \<GG>)"
	+ proof(intro is_cf_cocontinuousI, rule assms)
	+ fix \<FF> \<JJ> assume prems': "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> .
	+ show "cf_preserves_colimits \<alpha> \<GG> \<FF>"
	by
	(
	- cs_concl cs_shallow
	- cs_simp:
	- the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
	- cs_intro: cat_cs_intros
	- )
	- qed (intro P\<^sub>O)
	-
	- from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O'] obtain f'
	- where f': "f' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	- and \<pi>\<^sub>O'_NTMap_app:
	- "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	- and unique_f':
	- "\<lbrakk>
	- f'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	- \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	- \<rbrakk> \<Longrightarrow> f'' = f'"
	- for f''
	- by metis
	-
	- have \<pi>\<^sub>O_NTMap_app_Cod:
	- "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	- proof-
	- from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
	- from \<pi>\<^sub>O'_NTMap_app[OF this] that show ?thesis
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_cs_simps the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	- )
	- qed
	-
	- from this[symmetric] have \<pi>\<^sub>A_NTMap_Comp_app:
	- "\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q"
	- if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O" for q f a b c
	- using that f'
	- by (intro \<FF>.HomCod.cat_assoc_helper)
	- (
	- cs_concl cs_shallow
	- cs_simp:
	- cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	- )+
	-
	- let ?g = \<open>\<lambda>u. \<FF>\<lparr>ArrMap\<rparr>\<lparr>u\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	- let ?\<pi>\<^sub>O'' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?g\<close>
	-
	- have \<pi>\<^sub>O'': "?\<pi>\<^sub>O'' : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding the_cat_discrete_components(1)
	- proof
	- (
	- intro
	- tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	- tm_cf_discrete
	- )
	- show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	- if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	- proof-
	- from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show ?thesis
	- by
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps cat_discrete_cs_simps
	- the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	- )
	- qed
	- qed (intro P\<^sub>O)
	-
	- from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O''] obtain g'
	- where g': "g' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	- and \<pi>\<^sub>O''_NTMap_app:
	- "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	- and unique_g':
	- "\<lbrakk>
	- g'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	- \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g''
	- \<rbrakk> \<Longrightarrow> g'' = g'"
	- for g''
	- by (metis (lifting))
	-
	- have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
	- if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	- proof-
	- from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
	- from \<pi>\<^sub>O''_NTMap_app[OF this] that show ?thesis
	- by
	- (
	- cs_prems cs_shallow
	- cs_simp: cat_cs_simps the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	+ rule cf_preserves_limits_op
	+ [
	+ THEN iffD1,
	+ OF
	+ prems'
	+ assms(1)
	+ is_cf_continuousD[OF that \<FF>.is_functor_op \<GG>.is_functor_op]
	+ ]
	)
	qed
	- then have \<pi>\<^sub>O_NTMap_app_Dom:
	- "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) =
	- (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q"
	- if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O" for q f a b c
	- using that g'
	- by (intro \<FF>.HomCod.cat_assoc_helper)
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	- )
	-
	- from assms(2)[OF f' g'] obtain E \<epsilon> where \<epsilon>:
	- "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (P\<^sub>O,P\<^sub>A,g',f') : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by clarsimp
	-
	- interpret \<epsilon>: is_cat_equalizer_2 \<alpha> P\<^sub>O P\<^sub>A g' f' \<CC> E \<epsilon> by (rule \<epsilon>)
	-
	- define \<mu> where "\<mu> =
	- [(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>), cf_const \<JJ> \<CC> E, \<FF>, \<JJ>, \<CC>]\<^sub>\<circ>"
	-
	- have \<mu>_components:
	- "\<mu>\<lparr>NTMap\<rparr> = (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)"
	- "\<mu>\<lparr>NTDom\<rparr> = cf_const \<JJ> \<CC> E"
	- "\<mu>\<lparr>NTCod\<rparr> = \<FF>"
	- "\<mu>\<lparr>NTDGDom\<rparr> = \<JJ>"
	- "\<mu>\<lparr>NTDGCod\<rparr> = \<CC>"
	- unfolding \<mu>_def nt_field_simps by (simp_all add: nat_omega_simps)
	-
	- have [cat_cs_simps]:
	- "\<mu>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- for i
	- using that unfolding \<mu>_components by simp
	-
	- have "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- proof(intro is_cat_limitI)
	-
	- show \<mu>: "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	- show "vfsequence \<mu>" unfolding \<mu>_def by simp
	- show "vcard \<mu> = 5\<^sub>\<nat>" unfolding \<mu>_def by (simp add: nat_omega_simps)
	- show "cf_const \<JJ> \<CC> E : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	- show "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	- show "\<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : cf_const \<JJ> \<CC> E\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- if "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a
	- using that
	- by
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps
	- cat_discrete_cs_simps
	- cat_parallel_cs_simps
	- the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
	- )
	- show
	- "\<mu>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	- \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for a b f
	- using that \<epsilon> g' f'
	- by
	- (
	- cs_concl
	- cs_simp:
	- cat_parallel_cs_simps
	- cat_cs_simps
	- the_cat_discrete_components(1)
	- \<pi>\<^sub>O_NTMap_app_Cod
	- \<pi>\<^sub>O_NTMap_app_Dom
	- \<epsilon>.cat_eq_2_Comp_eq(1)
	- cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
	- )
	-
	- qed (auto simp: \<mu>_components cat_lim_cs_intros)
	-
	- interpret \<mu>: is_cat_cone \<alpha> E \<JJ> \<CC> \<FF> \<mu> by (rule \<mu>)
	-
	- show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	- if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" for u' r'
	- proof-
	-
	- interpret u': is_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> u' by (rule that)
	+ show "is_cf_continuous \<alpha> (op_cf \<GG>)" if "is_cf_cocontinuous \<alpha> \<GG>"
	+ proof(intro is_cf_continuousI, rule \<GG>.is_functor_op)
	+ fix \<FF> \<JJ> assume prems': "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	+ then interpret \<FF>: is_functor \<alpha> \<JJ> \<open>op_cat \<AA>\<close> \<FF> .
	+ from that assms have op_op_bundle:
	+ "is_cf_cocontinuous \<alpha> (op_cf (op_cf \<GG>))"
	+ "op_cf (op_cf \<GG>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ unfolding cat_op_simps .
	+ show "cf_preserves_limits \<alpha> (op_cf \<GG>) \<FF>"
	+ by
	+ (
	+ rule cf_preserves_colimits_op
	+ [
	+ THEN iffD1,
	+ OF
	+ \<FF>.is_functor_axioms
	+ \<GG>.is_functor_op
	+ is_cf_cocontinuousD
	+ [
	+ OF
	+ op_op_bundle(1)
	+ \<FF>.is_functor_op[unfolded cat_op_simps]
	+ op_op_bundle(2)
	+ ]
	+ ]
	+ )
	+ qed
	+qed

	- let ?u' = \<open>\<lambda>j. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<close>
	- let ?\<pi>' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Obj\<rparr>) ?R r' ?u'\<close>
	-
	- have \<pi>'_NTMap_app: "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	- using that
	- unfolding ntcf_obj_prod_base_components the_cat_discrete_components
	- by auto
	+lemma is_cf_cocontinuous_op[cat_op_simps]:
	+ assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ shows "is_cf_cocontinuous \<alpha> (op_cf \<GG>) \<longleftrightarrow> is_cf_continuous \<alpha> \<GG>"
	+proof
	+ interpret \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
	+ show "is_cf_continuous \<alpha> \<GG>" if "is_cf_cocontinuous \<alpha> (op_cf \<GG>)"
	+ proof(intro is_cf_continuousI, rule assms)
	+ fix \<FF> \<JJ> assume prems': "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<FF>: is_functor \<alpha> \<JJ> \<AA> \<FF> .
	+ show "cf_preserves_limits \<alpha> \<GG> \<FF>"
	+ by
	+ (
	+ rule cf_preserves_colimits_op
	+ [
	+ THEN iffD1,
	+ OF
	+ prems'
	+ assms(1)
	+ is_cf_cocontinuousD[OF that \<FF>.is_functor_op \<GG>.is_functor_op]
	+ ]
	+ )
	+ qed
	+ show "is_cf_cocontinuous \<alpha> (op_cf \<GG>)" if "is_cf_continuous \<alpha> \<GG>"
	+ proof(intro is_cf_cocontinuousI, rule \<GG>.is_functor_op)
	+ fix \<FF> \<JJ> assume prems': "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	+ then interpret \<FF>: is_functor \<alpha> \<JJ> \<open>op_cat \<AA>\<close> \<FF> .
	+ from that assms have op_op_bundle:
	+ "is_cf_continuous \<alpha> (op_cf (op_cf \<GG>))"
	+ "op_cf (op_cf \<GG>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ unfolding cat_op_simps .
	+ show "cf_preserves_colimits \<alpha> (op_cf \<GG>) \<FF>"
	+ by
	+ (
	+ rule cf_preserves_limits_op
	+ [
	+ THEN iffD1,
	+ OF
	+ \<FF>.is_functor_axioms
	+ \<GG>.is_functor_op
	+ is_cf_continuousD
	+ [
	+ OF
	+ op_op_bundle(1)
	+ \<FF>.is_functor_op[unfolded cat_op_simps]
	+ op_op_bundle(2)
	+ ]
	+ ]
	+ )
	+ qed
	+qed

	- have \<pi>': "?\<pi>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC> : :\<^sub>C (\<JJ>\<lparr>Obj\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding the_cat_discrete_components(1)
	- proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
	- show "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
	- proof(intro tm_cf_discreteI)
	- show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: that cat_cs_intros)
	- show "category \<alpha> \<CC>" by (auto intro: cat_cs_intros)
	- from \<FF>.tm_cf_ObjMap_in_Vset show "(\<lambda>x\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by (auto simp: \<FF>.cf_ObjMap_vdomain)
	- show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	- have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- proof(intro vsubsetI)
	- fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>)"
	- then obtain i where i: "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- and x_def: "x = \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>"
	- by auto
	- from i have "x = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr>\<rparr>"
	- by (simp add: x_def \<FF>.cf_ObjMap_CId)
	- moreover from i have "\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- ultimately show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
	- by (auto intro: \<FF>.ArrMap.vsv_vimageI2)
	- qed
	- then show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	- by
	- (
	- auto simp:
	- \<FF>.tm_cf_ArrMap_in_Vset vrange_in_VsetI vsubset_in_VsetI
	- )
	- qed (auto intro: \<FF>.HomDom.tiny_cat_Obj_in_Vset)
	- qed
	- show "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	- using that
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- qed (auto simp: cat_lim_cs_intros)

	- from \<pi>\<^sub>O.cat_obj_prod_unique_cone'[OF this] obtain h'
	- where h': "h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
	- and \<pi>'_NTMap_app':
	- "\<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	- and unique_h': "\<And>h''.
	- \<lbrakk>
	- h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O;
	- \<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''
	- \<rbrakk> \<Longrightarrow> h'' = h'"
	- by metis
	-
	- interpret \<pi>':
	- is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Obj\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) (app (\<FF>\<lparr>ObjMap\<rparr>)) \<CC>\<close> ?\<pi>'
	- by (rule \<pi>')
	-
	- let ?u'' = \<open>\<lambda>u. u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close>
	- let ?\<pi>'' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Arr\<rparr>) ?L r' ?u''\<close>
	+subsubsection\<open>Category isomorphisms are continuous and cocontinuous\<close>

	- have \<pi>''_NTMap_app: "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	- if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b
	- using that
	- unfolding ntcf_obj_prod_base_components the_cat_discrete_components
	- by
	+lemma (in is_iso_functor) iso_cf_is_cf_continuous: "is_cf_continuous \<alpha> \<FF>"
	+proof(intro is_cf_continuousI)
	+ fix \<JJ> \<GG> assume prems: "\<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<GG>: is_functor \<alpha> \<JJ> \<AA> \<GG> .
	+ show "cf_preserves_limits \<alpha> \<FF> \<GG>"
	+ proof(intro cf_preserves_limitsI)
	+ fix a \<sigma> assume "\<sigma> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<sigma>: is_cat_limit \<alpha> \<JJ> \<AA> \<GG> a \<sigma> .
	+ show "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ proof(intro is_cat_limitI)
	+ fix r' \<tau> assume "\<tau> : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ then interpret \<tau>: is_cat_cone \<alpha> r' \<JJ> \<BB> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> \<tau> .
	+ note [cat_cs_simps] = cf_comp_assoc_helper[
	+ where \<HH>=\<open>inv_cf \<FF>\<close> and \<GG>=\<FF> and \<FF>=\<GG> and \<Q>=\<open>cf_id \<AA>\<close>
	+ ]
	+ have inv_\<tau>: "inv_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau> :
	+ inv_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	+ by
	(
	- cs_concl cs_shallow
	- cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	+ cs_concl
	+ cs_simp: cat_cs_simps cf_cs_simps
	+ cs_intro: cat_cs_intros cf_cs_intros
	)
	-
	- have \<pi>'': "?\<pi>'' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- unfolding the_cat_discrete_components(1)
	- proof
	- (
	- intro
	- tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
	- tm_cf_discrete
	- )
	- fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
	- then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then show "u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
	+ from is_cat_limit.cat_lim_unique_cone'[OF \<sigma>.is_cat_limit_axioms inv_\<tau>]
	+ obtain f where f: "f : inv_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a"
	+ and f_up: "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ (inv_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f"
	+ and f_unique:
	+ "\<lbrakk>
	+ f' : inv_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a;
	+ \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow>
	+ (inv_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f'
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+ have [cat_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	+ proof-
	+ from f_up[OF that] that have
	+ "inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr>\<rparr> =
	+ \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr>"
	+ by simp
	+ from this that f show ?thesis
	by
	(
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- qed (simp add: cat_lim_cs_intros)
	-
	- from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF this] obtain h''
	- where h'': "h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	- and \<pi>''_NTMap_app':
	- "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''"
	- and unique_h'': "\<And>h'''.
	- \<lbrakk>
	- h''' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
	- \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'''
	- \<rbrakk> \<Longrightarrow> h''' = h''"
	- by metis
	-
	- interpret \<pi>'': is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>\<close> ?\<pi>''
	- by (rule \<pi>'')
	-
	- have g'h'_f'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	- proof-
	-
	- from g' h' have g'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from f' h' have f'h': "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	-
	- have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	- if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cf_cs_simps cs_intro: cat_cs_intros
	+ )
	+ simp
	+ qed
	+ show "\<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<and> \<tau> = \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ from f have
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>inv_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ then show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : r' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_prems cs_shallow cs_simp: cf_cs_simps cs_intro: cat_cs_intros)
	+ show "\<tau> = \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
	+ proof(rule ntcf_eqI, rule \<tau>.is_ntcf_axioms)
	+ from f show "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) :
	+ cf_const \<JJ> \<BB> r' \<mapsto>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cf_cs_simps cs_intro: cat_cs_intros
	+ )
	+ then have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>))\<lparr>NTMap\<rparr>) =
	+ \<JJ>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps)
	+ show
	+ "\<tau>\<lparr>NTMap\<rparr> = (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>))\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold \<tau>.ntcf_NTMap_vdomain dom_rhs)
	+ fix j assume "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ with f show "\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>))\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
	+ qed simp_all
	+ fix f' assume prems':
	+ "f' : r' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ "\<tau> = \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> f'"
	+ have \<tau>j_def: "\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f'"
	+ if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	proof-
	- from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	- by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
	- also from f have "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by
	- (
	- cs_concl
	- cs_simp: \<pi>'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
	- )
	- also from f g' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	- by
	+ from prems'(2) have
	+ "\<tau>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<sigma> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<BB> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+ by simp
	+ from this prems'(1) that show ?thesis
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+ have "inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> = f"
	+ proof(rule f_unique)
	+ from prems'(1) show
	+ "inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : inv_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a"
	+ by
	(
	cs_concl
	- cs_simp:
	- cat_cs_simps
	- cat_discrete_cs_simps
	- the_cat_discrete_components(1)
	- \<pi>'_NTMap_app'
	- \<pi>\<^sub>O_NTMap_app_Dom
	- cs_intro: cat_cs_intros
	+ cs_simp: cf_cs_simps cs_intro: cat_cs_intros cf_cs_intros
	)
	- finally show ?thesis by simp
	- qed
	-
	- from unique_h''[OF g'h' this, simplified] have g'h'_h'':
	- "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
	- have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	- if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
	- proof-
	- from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
	- then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	- by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
	- also from f have "\<dots> = ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	- by
	+ fix j assume "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	+ from this prems'(1) show
	+ "(inv_cf \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<tau>)\<lparr>NTMap\<rparr>\<lparr>j\<rparr> =
	+ \<sigma>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	+ by
	(
	- cs_concl cs_shallow
	- cs_simp: \<pi>'_NTMap_app cs_intro: cat_cs_intros
	- )
	- also from f have "\<dots> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: \<pi>'_NTMap_app' cs_intro: cat_cs_intros
	+ cs_concl
	+ cs_simp: cat_cs_simps cf_cs_simps \<tau>j_def
	+ cs_intro: cat_cs_intros cf_cs_intros
	)
	- also from f g' h' have "\<dots> = (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: \<pi>\<^sub>O_NTMap_app_Cod cs_intro: cat_cs_intros
	- )
	- also from that f' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros
	- )
	- finally show ?thesis by simp
	qed
	- from unique_h''[OF f'h' this, simplified] have f'h'_h'':
	- "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
	- from g'h'_h'' f'h'_h'' show ?thesis by simp
	- qed
	-
	- let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	- and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f'\<close>
	-
	- define \<epsilon>' where "\<epsilon>' =
	- [
	- (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'))),
	- cf_const ?II \<CC> r',
	- ?II_II,
	- ?II,
	- \<CC>
	- ]\<^sub>\<circ>"
	-
	- have \<epsilon>'_components:
	- "\<epsilon>'\<lparr>NTMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')))"
	- "\<epsilon>'\<lparr>NTDom\<rparr> = cf_const ?II \<CC> r'"
	- "\<epsilon>'\<lparr>NTCod\<rparr> = ?II_II"
	- "\<epsilon>'\<lparr>NTDGDom\<rparr> = ?II"
	- "\<epsilon>'\<lparr>NTDGCod\<rparr> = \<CC>"
	- unfolding \<epsilon>'_def nt_field_simps by (simp_all add: nat_omega_simps)
	-
	- have \<epsilon>'_NTMap_app_I2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = h'" if "x = \<aa>\<^sub>P\<^sub>L\<^sub>2" for x
	- proof-
	- have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
	- then show ?thesis unfolding \<epsilon>'_components that by simp
	- qed
	-
	- have \<epsilon>'_NTMap_app_sI2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'" if "x = \<bb>\<^sub>P\<^sub>L\<^sub>2" for x
	- proof-
	- have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	- unfolding that by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	- with \<epsilon>.cat_parallel_\<aa>\<bb> show ?thesis
	- unfolding \<epsilon>'_components by (cs_concl cs_simp: V_cs_simps that)
	- qed
	-
	- interpret par: cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f' \<CC>
	- by (intro cf_parallel_2I cat_parallel_2I)
	- (
	- simp_all add:
	- cat_cs_intros cat_parallel_cs_intros cat_PL2_ineq[symmetric]
	- )
	-
	- have "\<epsilon>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	- show "vfsequence \<epsilon>'" unfolding \<epsilon>'_def by auto
	- show "vcard \<epsilon>' = 5\<^sub>\<nat>" unfolding \<epsilon>'_def by (simp add: nat_omega_simps)
	- from h' show "cf_const (?II) \<CC> r' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros
	- )
	- from h' show "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	- cf_const ?II \<CC> r'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> ?II_II\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	- if "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>" for a
	- using that
	- by (elim the_cat_parallel_2_ObjE; simp only:)
	- (
	- cs_concl
	- cs_simp:
	- \<epsilon>'_NTMap_app_I2 \<epsilon>'_NTMap_app_sI2
	- cat_cs_simps cat_parallel_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- from h' f' g'h'_f'h' show
	- "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const ?II \<CC> r'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	- ?II_II\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- if "f : a \<mapsto>\<^bsub>?II\<^esub> b" for a b f
	- using that
	- by (elim \<epsilon>.the_cat_parallel_2_is_arrE; simp only:)
	+ then have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>inv_cf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" by simp
	+ from this prems'(1) show "f' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	+ by
	(
	- cs_concl
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- cs_simp:
	- cat_cs_simps
	- cat_parallel_cs_simps
	- \<epsilon>'_NTMap_app_I2
	- \<epsilon>'_NTMap_app_sI2
	- )+
	- qed
	- (
	- simp add: \<epsilon>'_components \|
	- cs_concl
	- cs_simp: cat_cs_simps
	- cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
	- )+
	- from \<epsilon>.cat_eq_2_unique_cone[OF this] obtain t'
	- where t': "t' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	- and \<epsilon>'_NTMap_app: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'"
	- and unique_t':
	- "\<lbrakk> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t''\<rbrakk> \<Longrightarrow>
	- t'' = t'"
	- for t''
	- by metis
	-
	- show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	- proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
	- show [symmetric, cat_cs_simps]: "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'"
	- proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
	- from t' show
	- "\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t' : cf_const \<JJ> \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- show "u'\<lparr>NTMap\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>"
	- proof(rule vsv_eqI)
	- show "vsv ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	- from t' show
	- "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	- )
	- show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>)" for a
	- proof-
	- from that have "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
	- by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	- with t' show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	- by
	- (
	- cs_concl
	- cs_simp:
	- cat_cs_simps
	- \<pi>'_NTMap_app
	- cat_parallel_cs_simps
	- the_cat_discrete_components(1)
	- \<epsilon>'_NTMap_app[symmetric]
	- \<epsilon>'_NTMap_app_I2
	- \<pi>'_NTMap_app'[symmetric]
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- qed
	- qed auto
	- qed simp_all
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cf_cs_simps cs_intro: cat_cs_intros
	+ )
	+ qed
	+ qed (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	+ qed (intro prems is_functor_axioms)+
	+qed (rule is_functor_axioms)

	- fix t'' assume prems': "t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t''"
	- then have u'_NTMap_app_x:
	- "u'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'')\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	- for x
	- by simp
	- have "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'')"
	- if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
	- using u'_NTMap_app_x[of j] prems'(1) that
	- by
	- (
	- cs_prems
	- cs_simp:
	- cat_cs_simps
	- cat_discrete_cs_simps
	- cat_parallel_cs_simps
	- the_cat_discrete_components(1)
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- (simp add: \<pi>'_NTMap_app[OF that, symmetric])
	- moreover from prems'(1) have "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cat_parallel_cs_simps
	- cs_intro: cat_cs_intros cat_parallel_cs_intros
	- )
	- ultimately have [cat_cs_simps]: "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' = h'"
	- by (intro unique_h') simp
	- show "t'' = t'"
	- by (rule unique_t', intro prems'(1))
	- (cs_concl cs_shallow cs_simp: \<epsilon>'_NTMap_app_I2 cat_cs_simps)
	- qed
	- qed
	-
	- qed
	-
	- then show ?thesis using that by clarsimp
	-
	-qed
	+lemma (in is_iso_functor) iso_cf_is_cf_cocontinuous: "is_cf_cocontinuous \<alpha> \<FF>"
	+ using is_iso_functor.iso_cf_is_cf_continuous[OF is_iso_functor_op]
	+ by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)

	-lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
	- \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
	- assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>; \<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa> \<rbrakk> \<Longrightarrow>
	- \<exists>E \<epsilon>. \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
	- \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
	- \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- obtains r u where "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	-proof-
	- interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
	- have "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- if "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" for \<aa> \<bb> \<gg> \<ff>
	- proof-
	- from assms(2)[OF that(1,2)] obtain E \<epsilon>
	- where \<epsilon>: "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by clarsimp
	- interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule \<epsilon>)
	- from \<epsilon>.is_cat_equalizer_2_op[unfolded cat_op_simps] show ?thesis by auto
	- qed
	- moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A (op_cat \<CC>)" for A
	- proof-
	- interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
	- from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi>
	- where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by clarsimp
	- interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
	- from \<pi>.is_cat_obj_prod_op show ?thesis by auto
	- qed
	- moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	- if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A (op_cat \<CC>)" for A
	- proof-
	- interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
	- from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi>
	- where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	- by clarsimp
	- interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
	- from \<pi>.is_cat_obj_prod_op show ?thesis by auto
	- qed
	- ultimately obtain u r where u:
	- "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+
	+
	+subsection\<open>Tiny-continuous and tiny-cocontinuous functor\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition is_tm_cf_continuous :: "V \<Rightarrow> V \<Rightarrow> bool"
	+ where "is_tm_cf_continuous \<alpha> \<GG> =
	+ (\<forall>\<FF> \<JJ>. \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<GG>\<lparr>HomDom\<rparr> \<longrightarrow> cf_preserves_limits \<alpha> \<GG> \<FF>)"
	+
	+
	+text\<open>Rules.\<close>
	+
	+context
	+ fixes \<alpha> \<JJ> \<AA> \<BB> \<GG> \<FF>
	+ assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
	+begin
	+
	+interpretation \<GG>: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule \<GG>)
	+
	+mk_ide rf is_tm_cf_continuous_def[where \<alpha>=\<alpha> and \<GG>=\<GG>, unfolded cat_cs_simps]
	+ \|intro is_tm_cf_continuousI\|
	+ \|dest is_tm_cf_continuousD'\|
	+ \|elim is_tm_cf_continuousE'\|
	+
	+end
	+
	+lemmas is_tm_cf_continuousD[dest!] = is_tm_cf_continuousD'[rotated]
	+ and is_tm_cf_continuousE[elim!] = is_tm_cf_continuousE'[rotated]
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_functor) cf_continuous_is_tm_cf_continuous:
	+ assumes "is_cf_continuous \<alpha> \<FF>"
	+ shows "is_tm_cf_continuous \<alpha> \<FF>"
	+proof(intro is_tm_cf_continuousI, rule is_functor_axioms)
	+ fix \<FF>' \<JJ> assume "\<FF>' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
	+ then interpret \<FF>': is_tm_functor \<alpha> \<JJ> \<AA> \<FF>'.
	+ show "cf_preserves_limits \<alpha> \<FF> \<FF>'"
	by
	(
	- rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
	- OF \<FF>.is_tm_functor_op, unfolded cat_op_simps
	- ]
	+ intro is_cf_continuousD[OF assms(1) _ is_functor_axioms],
	+ rule \<FF>'.is_functor_axioms
	)
	- interpret u: is_cat_limit \<alpha> \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> r u by (rule u)
	- from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Equalizer.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Equalizer.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Equalizer.thy
	@@ -0,0 +1,1544 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Equalizers and coequalizers as limits and colimits\<close>
	+theory CZH_UCAT_Limit_Equalizer
	+ imports
	+ CZH_UCAT_Limit
	+ CZH_Elementary_Categories.CZH_ECAT_Parallel
	+begin
	+
	+
	+
	+subsection\<open>Equalizer and coequalizer\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+See \cite{noauthor_wikipedia_2001}\footnote{
	+\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
	+}.
	+\<close>
	+
	+locale is_cat_equalizer =
	+ is_cat_limit \<alpha> \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close> \<CC> \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close> E \<epsilon> +
	+ F': vsv F'
	+ for \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> +
	+ assumes cat_eq_F_in_Vset[cat_lim_cs_intros]: "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and cat_eq_F_ne[cat_lim_cs_intros]: "F \<noteq> 0"
	+ and cat_eq_F'_vdomain[cat_lim_cs_simps]: "\<D>\<^sub>\<circ> F' = F"
	+ and cat_eq_F'_app_is_arr[cat_lim_cs_intros]: "\<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+
	+syntax "_is_cat_equalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q '(_,_,_,_') :/ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	+translations "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon>"
	+
	+locale is_cat_coequalizer =
	+ is_cat_colimit \<alpha> \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close> \<CC> \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close> E \<epsilon> +
	+ F': vsv F'
	+ for \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> +
	+ assumes cat_coeq_F_in_Vset[cat_lim_cs_intros]: "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and cat_coeq_F_ne[cat_lim_cs_intros]: "F \<noteq> 0"
	+ and cat_coeq_F'_vdomain[cat_lim_cs_simps]: "\<D>\<^sub>\<circ> F' = F"
	+ and cat_coeq_F'_app_is_arr[cat_lim_cs_intros]: "\<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+
	+syntax "_is_cat_coequalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ '(_,_,_,_') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q _ :/ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	+translations "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "E' = E"
	+ and "\<aa>' = \<aa>"
	+ and "\<bb>' = \<bb>"
	+ and "F'' = F"
	+ and "F''' = F'"
	+ and "\<CC>' = \<CC>"
	+ shows "\<epsilon> : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>',\<bb>',F'',F''') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_equalizer_axioms)
	+
	+mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
	+ \|intro is_cat_equalizerI\|
	+ \|dest is_cat_equalizerD[dest]\|
	+ \|elim is_cat_equalizerE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)
	+
	+lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "E' = E"
	+ and "\<aa>' = \<aa>"
	+ and "\<bb>' = \<bb>"
	+ and "F'' = F"
	+ and "F''' = F'"
	+ and "\<CC>' = \<CC>"
	+ shows "\<epsilon> : (\<aa>',\<bb>',F'',F''') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_coequalizer_axioms)
	+
	+mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
	+ \|intro is_cat_coequalizerI\|
	+ \|dest is_cat_coequalizerD[dest]\|
	+ \|elim is_cat_coequalizerE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_cat_equalizer)
	+ cat_eq_\<aa>[cat_lim_cs_intros]: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and cat_eq_\<bb>[cat_lim_cs_intros]: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+proof-
	+ from cat_eq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	+ have "F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" by (rule cat_eq_F'_app_is_arr[OF \<ff>])
	+ then show "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+qed
	+
	+lemma (in is_cat_coequalizer)
	+ cat_coeq_\<aa>[cat_lim_cs_intros]: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and cat_coeq_\<bb>[cat_lim_cs_intros]: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+proof-
	+ from cat_coeq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	+ have "F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" by (rule cat_coeq_F'_app_is_arr[OF \<ff>])
	+ then show "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+qed
	+
	+sublocale is_cat_equalizer \<subseteq> cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	+ by (intro cf_parallelI cat_parallelI)
	+ (
	+ auto simp:
	+ cat_lim_cs_simps cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	+ )
	+
	+sublocale is_cat_coequalizer \<subseteq> cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	+ by (intro cf_parallelI cat_parallelI)
	+ (
	+ auto simp:
	+ cat_lim_cs_simps cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	+ )
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_equalizer) is_cat_coequalizer_op:
	+ "op_ntcf \<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_coequalizerI)
	+ (
	+ cs_concl
	+ cs_simp: cat_lim_cs_simps cat_op_simps
	+ cs_intro: V_cs_intros cat_op_intros cat_lim_cs_intros
	+ )+
	+
	+lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_coequalizer_op)
	+
	+lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'
	+
	+lemma (in is_cat_coequalizer) is_cat_equalizer_op:
	+ "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_equalizerI)
	+ (
	+ cs_concl
	+ cs_simp: cat_lim_cs_simps cat_op_simps
	+ cs_intro: V_cs_intros cat_op_intros cat_lim_cs_intros
	+ )+
	+
	+lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_equalizer_op)
	+
	+lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'
	+
	+
	+text\<open>Further properties.\<close>
	+
	+lemma (in category) cat_cf_parallel_\<aa>\<bb>:
	+ assumes "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows "cf_parallel \<alpha> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' \<CC>"
	+proof-
	+ have "\<aa>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (simp_all add: Axiom_of_Pairing \<bb>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L_def assms(2))
	+ then show ?thesis
	+ by (intro cf_parallelI cat_parallelI)
	+ (simp_all add: assms cat_parallel_cs_intros cat_cs_intros)
	+qed
	+
	+lemma (in category) cat_cf_parallel_\<bb>\<aa>:
	+ assumes "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows "cf_parallel \<alpha> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' \<CC>"
	+proof-
	+ have "\<aa>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>" "\<bb>\<^sub>P\<^sub>L F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (simp_all add: Axiom_of_Pairing \<bb>\<^sub>P\<^sub>L_def \<aa>\<^sub>P\<^sub>L_def assms(2))
	+ then show ?thesis
	+ by (intro cf_parallelI cat_parallelI)
	+ (simp_all add: assms cat_parallel_cs_intros cat_cs_intros)
	+qed
	+
	+lemma cat_cone_cf_par_eps_NTMap_app:
	+ assumes "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	+ \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+proof-
	+ let ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close>
	+ and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	+ interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ interpret par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	+ by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<aa>\<bb> assms \<aa> \<bb>)
	+ from assms(6) have \<ff>: "\<ff> : \<aa>\<^sub>P\<^sub>L F \<mapsto>\<^bsub>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<^esub> \<bb>\<^sub>P\<^sub>L F"
	+ by (simp_all add: par.the_cat_parallel_is_arr_\<aa>\<bb>F)
	+ note \<epsilon>.cat_cone_Comp_commute[cat_cs_simps del]
	+ from \<epsilon>.ntcf_Comp_commute[OF \<ff>] assms(6) show ?thesis
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_parallel_cs_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+qed
	+
	+lemma cat_cocone_cf_par_eps_NTMap_app:
	+ assumes "\<epsilon> :
	+ \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	+ \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	+proof-
	+ let ?II = \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close>
	+ and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close>
	+ interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from assms(5,6)
	+ have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and F'\<ff>: "F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ by auto
	+ interpret par: cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	+ by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<bb>\<aa> assms \<aa> \<bb>)
	+ note \<epsilon>_NTMap_app =
	+ cat_cone_cf_par_eps_NTMap_app[
	+ OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps,
	+ OF assms(2-6),
	+ simplified
	+ ]
	+ from \<epsilon>_NTMap_app F'\<ff> show ?thesis
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric]
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+qed
	+
	+lemma (in is_cat_equalizer) cat_eq_eps_NTMap_app:
	+ assumes "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ by
	+ (
	+ intro cat_cone_cf_par_eps_NTMap_app[
	+ OF
	+ is_cat_cone_axioms
	+ F'.vsv_axioms
	+ cat_eq_F_in_Vset
	+ cat_eq_F'_vdomain
	+ cat_eq_F'_app_is_arr
	+ assms
	+ ]
	+ )+
	+
	+lemma (in is_cat_coequalizer) cat_coeq_eps_NTMap_app:
	+ assumes "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	+ by
	+ (
	+ intro cat_cocone_cf_par_eps_NTMap_app[
	+ OF is_cat_cocone_axioms
	+ F'.vsv_axioms
	+ cat_coeq_F_in_Vset
	+ cat_coeq_F'_vdomain
	+ cat_coeq_F'_app_is_arr
	+ assms
	+ ]
	+ )+
	+
	+lemma (in is_cat_equalizer) cat_eq_Comp_eq:
	+ assumes "\<gg> \<in>\<^sub>\<circ> F" and "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "F'\<lparr>\<gg>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = F'\<lparr>\<ff>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ using cat_eq_eps_NTMap_app[OF assms(1)] cat_eq_eps_NTMap_app[OF assms(2)]
	+ by auto
	+
	+lemma (in is_cat_coequalizer) cat_coeq_Comp_eq:
	+ assumes "\<gg> \<in>\<^sub>\<circ> F" and "\<ff> \<in>\<^sub>\<circ> F"
	+ shows "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<gg>\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> F'\<lparr>\<ff>\<rparr>"
	+ using cat_coeq_eps_NTMap_app[OF assms(1)] cat_coeq_eps_NTMap_app[OF assms(2)]
	+ by auto
	+
	+
	+subsubsection\<open>Universal property\<close>
	+
	+lemma is_cat_equalizerI':
	+ assumes "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	+ \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<ff> \<in>\<^sub>\<circ> F"
	+ and "\<And>\<epsilon>' E'. \<epsilon>' :
	+ E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	+ \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+
	+ let ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close>
	+ and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	+ interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ interpret par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<CC>
	+ by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<aa>\<bb> assms \<aa> \<bb>) simp
	+
	+ show ?thesis
	+ proof(intro is_cat_equalizerI is_cat_limitI assms(1-3))
	+ fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ interpret u': is_cat_cone \<alpha> r' ?II \<CC> ?II_II u' by (rule prems)
	+ from assms(7)[OF prems] obtain f'
	+ where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ and u'_NTMap_app_\<aa>: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ and unique_f':
	+ "\<And>f''.
	+ \<lbrakk>
	+ f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E;
	+ u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	+ \<rbrakk> \<Longrightarrow> f'' = f'"
	+ by metis
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	+ proof(rule ntcf_eqI)
	+ show "u' : cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule u'.is_ntcf_axioms)
	+ from f' show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f' :
	+ cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
	+ have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	+ unfolding cat_cs_simps by simp
	+ from f' have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ note [cat_parallel_cs_simps] =
	+ cat_cone_cf_par_eps_NTMap_app[
	+ OF u'.is_cat_cone_axioms assms(2-5), simplified
	+ ]
	+ cat_cone_cf_par_eps_NTMap_app[OF assms(1-5), simplified]
	+ u'_NTMap_app_\<aa>
	+ from prems' f' assms(6) show
	+ "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by (elim the_cat_parallel_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp: cat_parallel_cs_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
	+ qed simp_all
	+ fix f'' assume prems'':
	+ "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
	+ from prems''(2) have u'_NTMap_a:
	+ "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ for a
	+ by simp
	+ have "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ using u'_NTMap_a[of \<open>\<aa>\<^sub>P\<^sub>L F\<close>] prems''(1)
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_parallel_cs_simps cat_cs_simps
	+ cs_intro: cat_parallel_cs_intros cat_cs_intros
	+ )
	+ from unique_f'[OF prems''(1) this] show "f'' = f'".
	+ qed (rule f')
	+ qed (use assms in fastforce)+
	+
	+qed
	+
	+lemma is_cat_coequalizerI':
	+ assumes "\<epsilon> :
	+ \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	+ \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "vsv F'"
	+ and "F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ and "\<D>\<^sub>\<circ> F' = F"
	+ and "\<And>\<ff>. \<ff> \<in>\<^sub>\<circ> F \<Longrightarrow> F'\<lparr>\<ff>\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<ff> \<in>\<^sub>\<circ> F"
	+ and "\<And>\<epsilon>' E'. \<epsilon>' :
	+ \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	+ \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ shows "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+
	+ let ?op_II = \<open>\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<close>
	+ and ?op_II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F'\<close>
	+ and ?II = \<open>\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<close>
	+ and ?II_II = \<open>\<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F (op_cat \<CC>) (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F'\<close>
	+ interpret \<epsilon>: is_cat_cocone \<alpha> E ?op_II \<CC> ?op_II_II \<epsilon> by (rule assms(1))
	+ from assms(5,6) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ interpret par: cf_parallel \<alpha> \<open>\<bb>\<^sub>P\<^sub>L F\<close> \<open>\<aa>\<^sub>P\<^sub>L F\<close> F \<bb> \<aa> F' \<CC>
	+ by (intro \<epsilon>.NTDom.HomCod.cat_cf_parallel_\<bb>\<aa> assms \<aa> \<bb>) simp
	+
	+ interpret op_par: cf_parallel \<alpha> \<open>\<aa>\<^sub>P\<^sub>L F\<close> \<open>\<bb>\<^sub>P\<^sub>L F\<close> F \<aa> \<bb> F' \<open>op_cat \<CC>\<close>
	+ by (rule par.cf_parallel_op)
	+ have assms_4':
	+ "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	+ if "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>" for \<epsilon>' E'
	+ proof-
	+ have [cat_op_simps]:
	+ "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	+ f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ for f'
	+ by (intro iffI conjI; (elim conjE)?)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )+
	+ interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<open>op_cat \<CC>\<close> ?II_II \<epsilon>' by (rule that)
	+ show ?thesis
	+ unfolding cat_op_simps
	+ by
	+ (
	+ rule assms(7)[
	+ OF \<epsilon>'.is_cat_cocone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+ qed
	+ interpret op_\<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<open>op_cat \<CC>\<close> E \<open>op_ntcf \<epsilon>\<close>
	+ by
	+ (
	+ rule
	+ is_cat_equalizerI'
	+ [
	+ OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps,
	+ OF assms(2-6) assms_4',
	+ simplified
	+ ]
	+ )
	+ show ?thesis by (rule op_\<epsilon>.is_cat_coequalizer_op[unfolded cat_op_simps])
	+
	+qed
	+
	+lemma (in is_cat_equalizer) cat_eq_unique_cone:
	+ assumes "\<epsilon>' :
	+ E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' : \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ (is \<open>\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	+ shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+
	+ interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
	+ from cat_lim_ua_fo[OF assms(1)] obtain f' where f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ and \<epsilon>'_def: "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
	+ and unique:
	+ "\<lbrakk> f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' \<rbrakk> \<Longrightarrow> f'' = f'"
	+ for f''
	+ by auto
	+ from cat_eq_F_ne obtain \<ff> where \<ff>: "\<ff> \<in>\<^sub>\<circ> F" by force
	+
	+ show ?thesis
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" by (rule f')
	+ from \<epsilon>'_def have "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ by simp
	+ from this f' show \<epsilon>'_NTMap_app_I: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ fix f'' assume prems:
	+ "f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ have "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
	+ proof(rule ntcf_eqI[OF ])
	+ show "\<epsilon>' : cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule \<epsilon>'.is_ntcf_axioms)
	+ from f' prems(1) show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' :
	+ cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<epsilon>'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold cat_cs_simps)
	+ show "vsv ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ from prems(1) show "?II\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ note [cat_cs_simps] =
	+ cat_eq_eps_NTMap_app[OF \<ff>]
	+ cat_cone_cf_par_eps_NTMap_app
	+ [
	+ OF
	+ \<epsilon>'.is_cat_cone_axioms
	+ F'.vsv_axioms
	+ cat_eq_F_in_Vset
	+ cat_eq_F'_vdomain
	+ cat_eq_F'_app_is_arr \<ff>,
	+ simplified
	+ ]
	+ from prems' prems(1) \<ff> have [cat_cs_simps]:
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ by (elim the_cat_parallel_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )+
	+ from prems' prems show
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed auto
	+ qed simp_all
	+ from unique[OF prems(1) this] show "f'' = f'" .
	+ qed
	+
	+qed
	+
	+lemma (in is_cat_equalizer) cat_eq_unique:
	+ assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f'"
	+ by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])
	+
	+lemma (in is_cat_equalizer) cat_eq_unique':
	+ assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+ interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(1))
	+ show ?thesis by (rule cat_eq_unique_cone[OF \<epsilon>'.is_cat_cone_axioms])
	+qed
	+
	+lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
	+ assumes "\<epsilon>' :
	+ \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<bb> \<aa> F' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	+ \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ (is \<open>\<epsilon>' : ?II_II >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	+ shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+proof-
	+ interpret \<epsilon>': is_cat_cocone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
	+ have [cat_op_simps]:
	+ "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	+ f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ for f'
	+ by (intro iffI conjI; (elim conjE)?)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )+
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_unique_cone[
	+ OF is_cat_equalizer_op \<epsilon>'.is_cat_cone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_coequalizer) cat_coeq_unique:
	+ assumes "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>' = ntcf_const (\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	+ by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])
	+
	+lemma (in is_cat_coequalizer) cat_coeq_unique':
	+ assumes "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+proof-
	+ interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(1))
	+ show ?thesis by (rule cat_coeq_unique_cocone[OF \<epsilon>'.is_cat_cocone_axioms])
	+qed
	+
	+lemma cat_equalizer_ex_is_iso_arr:
	+ assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	+ and "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f"
	+proof-
	+ interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr[
	+ OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_equalizer_ex_is_iso_arr':
	+ assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,F,F') : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+proof-
	+ interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	+ obtain f where f: "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	+ and "j \<in>\<^sub>\<circ> \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr'[
	+ OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
	+ ]
	+ )
	+ then have
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ unfolding the_cat_parallel_components by auto
	+ with f show ?thesis using that by simp
	+qed
	+
	+lemma cat_coequalizer_ex_is_iso_arr:
	+ assumes "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	+ and "\<epsilon>' = ntcf_const (\<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	+proof-
	+ interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr[
	+ OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_coequalizer_ex_is_iso_arr':
	+ assumes "\<epsilon> : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : (\<aa>,\<bb>,F,F') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr>"
	+proof-
	+ interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> F F' \<CC> E' \<epsilon>' by (rule assms(2))
	+ obtain f where f: "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	+ and "j \<in>\<^sub>\<circ> \<Up>\<^sub>C (\<bb>\<^sub>P\<^sub>L F) (\<aa>\<^sub>P\<^sub>L F) F\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr'[
	+ OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
	+ ]
	+ )
	+ then have
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr>"
	+ "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L F\<rparr>"
	+ unfolding the_cat_parallel_components by auto
	+ with f show ?thesis using that by simp
	+qed
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_cat_equalizer) cat_eq_is_monic_arr:
	+ \<comment>\<open>See subsection 3.3 in \cite{awodey_category_2010}.\<close>
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : E \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> \<aa>"
	+proof(intro is_monic_arrI)
	+ show "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : E \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_parallel_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ fix f g a
	+ assume prems:
	+ "f : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ "g : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	+ define \<epsilon>' where "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F) \<CC> f"
	+ from prems(1) have "\<epsilon>' :
	+ a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<Up>\<rightarrow>\<Up>\<^sub>C\<^sub>F \<CC> (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<aa> \<bb> F' :
	+ \<Up>\<^sub>C (\<aa>\<^sub>P\<^sub>L F) (\<bb>\<^sub>P\<^sub>L F) F \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ unfolding \<epsilon>'_def
	+ by (cs_concl cs_shallow cs_intro: is_cat_coneI cat_cs_intros)
	+ from cat_eq_unique_cone[OF this] obtain f'
	+ where f': "f' : a \<mapsto>\<^bsub>\<CC>\<^esub> E"
	+ and \<epsilon>'_\<aa>: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ and unique_f': "\<And>f''.
	+ \<lbrakk> f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'' \<rbrakk> \<Longrightarrow>
	+ f'' = f'"
	+ by meson
	+ from prems(1) have unique_f: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ unfolding \<epsilon>'_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ from prems(1) have unique_g: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g"
	+ unfolding \<epsilon>'_def
	+ by
	+ (
	+ cs_concl
	+ cs_simp: prems(3) cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ show "f = g"
	+ by
	+ (
	+ rule unique_f'
	+ [
	+ OF prems(1) unique_f,
	+ unfolded unique_f'[OF prems(2) unique_g, symmetric]
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_coequalizer) cat_coeq_is_epic_arr:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L F\<rparr> : \<aa> \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> E"
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_is_monic_arr[
	+ OF is_cat_equalizer_op, unfolded cat_op_simps
	+ ]
	+ )
	+
	+
	+
	+subsection\<open>Equalizer and coequalizer for two arrows\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+See \cite{noauthor_wikipedia_2001}\footnote{
	+\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
	+}.
	+\<close>
	+
	+locale is_cat_equalizer_2 =
	+ is_cat_limit \<alpha> \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close> E \<epsilon>
	+ for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
	+ assumes cat_eq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and cat_eq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+
	+syntax "_is_cat_equalizer_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q '(_,_,_,_') :/ \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	+translations "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
	+
	+locale is_cat_coequalizer_2 =
	+ is_cat_colimit
	+ \<alpha> \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close> E \<epsilon>
	+ for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
	+ assumes cat_coeq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and cat_coeq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+
	+syntax "_is_cat_coequalizer_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ '(_,_,_,_') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q _ :/ \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
	+translations "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_equalizer_2) is_cat_equalizer_2_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "E' = E"
	+ and "\<aa>' = \<aa>"
	+ and "\<bb>' = \<bb>"
	+ and "\<gg>' = \<gg>"
	+ and "\<ff>' = \<ff>"
	+ and "\<CC>' = \<CC>"
	+ shows "\<epsilon> : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>',\<bb>',\<gg>',\<ff>') : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_equalizer_2_axioms)
	+
	+mk_ide rf is_cat_equalizer_2_def[unfolded is_cat_equalizer_2_axioms_def]
	+ \|intro is_cat_equalizer_2I\|
	+ \|dest is_cat_equalizer_2D[dest]\|
	+ \|elim is_cat_equalizer_2E[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_equalizer_2D(1)
	+
	+lemma (in is_cat_coequalizer_2) is_cat_coequalizer_2_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "E' = E"
	+ and "\<aa>' = \<aa>"
	+ and "\<bb>' = \<bb>"
	+ and "\<gg>' = \<gg>"
	+ and "\<ff>' = \<ff>"
	+ and "\<CC>' = \<CC>"
	+ shows "\<epsilon> : (\<aa>',\<bb>',\<gg>',\<ff>') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_coequalizer_2_axioms)
	+
	+mk_ide rf is_cat_coequalizer_2_def[unfolded is_cat_coequalizer_2_axioms_def]
	+ \|intro is_cat_coequalizer_2I\|
	+ \|dest is_cat_coequalizer_2D[dest]\|
	+ \|elim is_cat_coequalizer_2E[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_coequalizer_2D(1)
	+
	+
	+text\<open>Helper lemmas.\<close>
	+
	+(FIXME)
	+lemma cat_eq_F'_helper:
	+ "(\<lambda>f\<in>\<^sub>\<circ>set {\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L}. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>)) =
	+ (\<lambda>f\<in>\<^sub>\<circ>set {\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))"
	+ using cat_PL2_\<gg>\<ff> by (simp add: VLambda_vdoubleton)
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+sublocale is_cat_equalizer_2 \<subseteq> cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>
	+ by (intro cf_parallel_2I cat_parallel_2I)
	+ (simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)
	+
	+sublocale is_cat_coequalizer_2 \<subseteq> cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>
	+ by (intro cf_parallel_2I cat_parallel_2I)
	+ (
	+ auto simp:
	+ cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
	+ cat_PL2_ineq[symmetric]
	+ )
	+
	+lemma (in is_cat_equalizer_2) cat_equalizer_2_is_cat_equalizer:
	+ "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) :
	+ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ intro is_cat_equalizerI,
	+ rule is_cat_limit_axioms[
	+ unfolded the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ )
	+ (auto simp: Limit_vdoubleton_in_VsetI cat_parallel_cs_intros)
	+
	+lemma (in is_cat_coequalizer_2) cat_coequalizer_2_is_cat_coequalizer:
	+ "\<epsilon> :
	+ (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E :
	+ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof
	+ (
	+ intro is_cat_coequalizerI,
	+ fold the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ )
	+ show "\<epsilon> :
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<bb> \<aa> \<gg> \<ff> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m E :
	+ \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ subst the_cat_parallel_2_commute,
	+ subst cf_parallel_2_the_cf_parallel_2_commute[symmetric]
	+ )
	+ (intro is_cat_colimit_axioms)
	+qed (auto simp: Limit_vdoubleton_in_VsetI cat_parallel_cs_intros)
	+
	+lemma cat_equalizer_is_cat_equalizer_2:
	+ assumes "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) :
	+ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret \<epsilon>: is_cat_equalizer
	+ \<alpha> \<aa> \<bb> \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close> \<open>(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<close> \<CC> E \<epsilon>
	+ by (rule assms)
	+ have \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	+ show ?thesis
	+ using \<epsilon>.cat_eq_F'_app_is_arr[OF \<gg>\<^sub>P\<^sub>L] \<epsilon>.cat_eq_F'_app_is_arr[OF \<ff>\<^sub>P\<^sub>L]
	+ by
	+ (
	+ intro
	+ is_cat_equalizer_2I
	+ \<epsilon>.is_cat_limit_axioms
	+ [
	+ folded
	+ the_cf_parallel_2_def the_cat_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ )
	+ (auto simp: cat_PL2_\<gg>\<ff>)
	+qed
	+
	+lemma cat_coequalizer_is_cat_coequalizer_2:
	+ assumes "\<epsilon> :
	+ (\<aa>,\<bb>,set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L},(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E :
	+ \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret is_cat_coequalizer
	+ \<alpha> \<aa> \<bb> \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close> \<open>(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<close> \<CC> E \<epsilon>
	+ by (rule assms)
	+ interpret cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<bb> \<aa> \<gg> \<ff> \<CC>
	+ by
	+ (
	+ rule cf_parallel_is_cf_parallel_2[
	+ OF cf_parallel_axioms cat_PL2_\<gg>\<ff>, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ )
	+ show "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ intro is_cat_coequalizer_2I,
	+ subst the_cat_parallel_2_commute,
	+ subst cf_parallel_2_the_cf_parallel_2_commute[symmetric],
	+ rule is_cat_colimit_axioms[
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cf_parallel_2_def
	+ ]
	+ )
	+ (simp_all add: cf_parallel_\<ff>' cf_parallel_\<gg>')
	+qed
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_equalizer_2) is_cat_coequalizer_2_op:
	+ "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ unfolding is_cat_equalizer_def
	+ by
	+ (
	+ rule cat_coequalizer_is_cat_coequalizer_2
	+ [
	+ OF is_cat_equalizer.is_cat_coequalizer_op[
	+ OF cat_equalizer_2_is_cat_equalizer
	+ ]
	+ ]
	+ )
	+
	+lemma (in is_cat_equalizer_2) is_cat_coequalizer_2_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_coequalizer_2_op)
	+
	+lemmas [cat_op_intros] = is_cat_equalizer_2.is_cat_coequalizer_2_op'
	+
	+lemma (in is_cat_coequalizer_2) is_cat_equalizer_2_op:
	+ "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ unfolding is_cat_coequalizer_def
	+ by
	+ (
	+ rule cat_equalizer_is_cat_equalizer_2
	+ [
	+ OF is_cat_coequalizer.is_cat_equalizer_op[
	+ OF cat_coequalizer_2_is_cat_coequalizer
	+ ]
	+ ]
	+ )
	+
	+lemma (in is_cat_coequalizer_2) is_cat_equalizer_2_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_equalizer_2_op)
	+
	+lemmas [cat_op_intros] = is_cat_coequalizer_2.is_cat_equalizer_2_op'
	+
	+
	+text\<open>Further properties.\<close>
	+
	+lemma (in category) cat_cf_parallel_2_cat_equalizer:
	+ assumes "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ shows "cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>"
	+ using assms
	+ by (intro cf_parallel_2I cat_parallel_2I)
	+ (auto simp: cat_parallel_cs_intros cat_cs_intros)
	+
	+lemma (in category) cat_cf_parallel_2_cat_coequalizer:
	+ assumes "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ shows "cf_parallel_2 \<alpha> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>"
	+ using assms
	+ by (intro cf_parallel_2I cat_parallel_2I)
	+ (simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL2_ineq[symmetric])
	+
	+lemma cat_cone_cf_par_2_eps_NTMap_app:
	+ assumes "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ shows
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+proof-
	+ let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	+ and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	+ and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	+ interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_vdoubleton_in_VsetI) auto
	+ from assms(2,3) have
	+ "(\<And>\<ff>'. \<ff>' \<in>\<^sub>\<circ> ?F \<Longrightarrow> (\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<lparr>\<ff>'\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>)"
	+ by auto
	+ note cat_cone_cf_par_eps_NTMap_app = cat_cone_cf_par_eps_NTMap_app
	+ [
	+ OF
	+ assms(1)[
	+ unfolded
	+ the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ],
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def, OF _ \<gg>\<ff> _ this,
	+ simplified
	+ ]
	+ from
	+ cat_cone_cf_par_eps_NTMap_app[of \<gg>\<^sub>P\<^sub>L, simplified]
	+ cat_cone_cf_par_eps_NTMap_app[of \<ff>\<^sub>P\<^sub>L, simplified]
	+ cat_PL2_\<gg>\<ff>
	+ show
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ by fastforce+
	+qed
	+
	+lemma cat_cocone_cf_par_2_eps_NTMap_app:
	+ assumes "\<epsilon> :
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	+ \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ shows
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+proof-
	+ let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close>
	+ and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
	+ and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	+ have \<ff>\<gg>_\<gg>\<ff>: "{\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L} = {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	+ interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_vdoubleton_in_VsetI) auto
	+ from assms(2,3) have
	+ "(\<And>\<ff>'. \<ff>' \<in>\<^sub>\<circ> ?F \<Longrightarrow> (\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>))\<lparr>\<ff>'\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>)"
	+ by auto
	+ note cat_cocone_cf_par_eps_NTMap_app = cat_cocone_cf_par_eps_NTMap_app
	+ [
	+ OF assms(1)
	+ [
	+ unfolded
	+ the_cat_parallel_2_def
	+ the_cf_parallel_2_def
	+ \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ insert_commute,
	+ unfolded \<ff>\<gg>_\<gg>\<ff>
	+ ],
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF _ \<gg>\<ff> _ this,
	+ simplified
	+ ]
	+ from
	+ cat_cocone_cf_par_eps_NTMap_app[of \<gg>\<^sub>P\<^sub>L, simplified]
	+ cat_cocone_cf_par_eps_NTMap_app[of \<ff>\<^sub>P\<^sub>L, simplified]
	+ cat_PL2_\<gg>\<ff>
	+ show
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ by fastforce+
	+qed
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_eps_NTMap_app:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+proof-
	+ have \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	+ note cat_eq_eps_NTMap_app = is_cat_equalizer.cat_eq_eps_NTMap_app
	+ [
	+ OF cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ from cat_eq_eps_NTMap_app[OF \<gg>\<^sub>P\<^sub>L] cat_eq_eps_NTMap_app[OF \<ff>\<^sub>P\<^sub>L] cat_PL2_\<gg>\<ff> show
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ by auto
	+qed
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_eps_NTMap_app:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+proof-
	+ have \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" and \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	+ note cat_eq_eps_NTMap_app = is_cat_coequalizer.cat_coeq_eps_NTMap_app
	+ [
	+ OF cat_coequalizer_2_is_cat_coequalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ from cat_eq_eps_NTMap_app[OF \<gg>\<^sub>P\<^sub>L] cat_eq_eps_NTMap_app[OF \<ff>\<^sub>P\<^sub>L] cat_PL2_\<gg>\<ff> show
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ by auto
	+qed
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_Comp_eq:
	+ "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ "\<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_Comp_eq:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all
	+
	+
	+subsubsection\<open>Universal property\<close>
	+
	+lemma is_cat_equalizer_2I':
	+ assumes "\<epsilon> :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<And>\<epsilon>' E'. \<epsilon>' :
	+ E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	+ \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	+ and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	+ and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	+ interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_vdoubleton_in_VsetI) auto
	+ from assms(2,3) have "(\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))\<lparr>\<ff>'\<rparr> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ if "\<ff>' \<in>\<^sub>\<circ> ?F" for \<ff>'
	+ using that by simp
	+ note is_cat_equalizerI' = is_cat_equalizerI'
	+ [
	+ OF
	+ assms(1)[
	+ unfolded
	+ the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def
	+ ],
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF
	+ _
	+ \<gg>\<ff>
	+ _
	+ this
	+ _
	+ assms(4)[unfolded the_cf_parallel_2_def the_cat_parallel_2_def],
	+ of \<gg>\<^sub>P\<^sub>L,
	+ simplified
	+ ]
	+ show ?thesis by (rule cat_equalizer_is_cat_equalizer_2[OF is_cat_equalizerI'])
	+qed
	+
	+lemma is_cat_coequalizer_2I':
	+ assumes "\<epsilon> :
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E :
	+ \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "\<And>\<epsilon>' E'. \<epsilon>' :
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	+ \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ shows "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close>
	+ and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
	+ and ?F = \<open>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}\<close>
	+ have \<ff>\<gg>_\<gg>\<ff>: "{\<ff>\<^sub>P\<^sub>L, \<gg>\<^sub>P\<^sub>L} = {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" by auto
	+ interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
	+ from \<epsilon>.cat_PL2_\<ff> \<epsilon>.cat_PL2_\<gg> have \<gg>\<ff>: "?F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (intro Limit_vdoubleton_in_VsetI) auto
	+ from assms(2,3) have "(\<lambda>f\<in>\<^sub>\<circ>set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}. (f = \<gg>\<^sub>P\<^sub>L ? \<gg> : \<ff>))\<lparr>\<ff>'\<rparr> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ if "\<ff>' \<in>\<^sub>\<circ> set {\<gg>\<^sub>P\<^sub>L, \<ff>\<^sub>P\<^sub>L}" for \<ff>'
	+ using that by simp
	+ note is_cat_coequalizerI'
	+ [
	+ OF assms(1)[
	+ unfolded
	+ the_cat_parallel_2_def the_cf_parallel_2_def \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def \<ff>\<gg>_\<gg>\<ff>
	+ ],
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF
	+ _
	+ \<gg>\<ff>
	+ _
	+ this
	+ _
	+ assms(4)[unfolded the_cf_parallel_2_def the_cat_parallel_2_def \<ff>\<gg>_\<gg>\<ff>],
	+ of \<gg>\<^sub>P\<^sub>L,
	+ simplified
	+ ]
	+ with cat_PL2_\<gg>\<ff> have
	+ "\<epsilon> : (\<aa>,\<bb>,?F,(\<lambda>f\<in>\<^sub>\<circ>?F. (f = \<ff>\<^sub>P\<^sub>L ? \<ff> : \<gg>))) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<Up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (auto simp: VLambda_vdoubleton)
	+ from cat_coequalizer_is_cat_coequalizer_2[OF this] show ?thesis by simp
	+qed
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_unique_cone:
	+ assumes "\<epsilon>' :
	+ E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	+ \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_unique_cone
	+ [
	+ OF cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF assms[unfolded the_cf_parallel_2_def the_cat_parallel_2_def]
	+ ]
	+ )
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_unique:
	+ assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f'"
	+proof-
	+ interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_unique
	+ [
	+ OF cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	+ folded the_cat_parallel_2_def
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_unique':
	+ assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+ interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_unique'
	+ [
	+ OF cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	+ folded the_cat_parallel_2_def
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_unique_cocone:
	+ assumes "\<epsilon>' :
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' :
	+ \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ by
	+ (
	+ rule is_cat_coequalizer.cat_coeq_unique_cocone
	+ [
	+ OF cat_coequalizer_2_is_cat_coequalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def insert_commute,
	+ OF assms[
	+ unfolded
	+ the_cf_parallel_2_def the_cat_parallel_2_def cat_eq_F'_helper
	+ ]
	+ ]
	+ )
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_unique:
	+ assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and>
	+ \<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	+proof-
	+ interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_coequalizer.cat_coeq_unique
	+ [
	+ OF cat_coequalizer_2_is_cat_coequalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	+ folded the_cat_parallel_2_def the_cat_parallel_2_commute
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_unique':
	+ assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+proof-
	+ interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms)
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_coequalizer.cat_coeq_unique'
	+ [
	+ OF cat_coequalizer_2_is_cat_coequalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def,
	+ OF \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	+ folded the_cat_parallel_2_def
	+ ]
	+ )
	+qed
	+
	+lemma cat_equalizer_2_ex_is_iso_arr:
	+ assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	+ and "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f"
	+proof-
	+ interpret \<epsilon>: is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	+ show ?thesis
	+ using that
	+ by
	+ (
	+ rule cat_equalizer_ex_is_iso_arr
	+ [
	+ OF
	+ \<epsilon>.cat_equalizer_2_is_cat_equalizer
	+ \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def
	+ ]
	+ )
	+qed
	+
	+lemma cat_equalizer_2_ex_is_iso_arr':
	+ assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+proof-
	+ interpret \<epsilon>: is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_equalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	+ show ?thesis
	+ using that
	+ by
	+ (
	+ rule cat_equalizer_ex_is_iso_arr'
	+ [
	+ OF
	+ \<epsilon>.cat_equalizer_2_is_cat_equalizer
	+ \<epsilon>'.cat_equalizer_2_is_cat_equalizer,
	+ folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def
	+ ]
	+ )
	+qed
	+
	+lemma cat_coequalizer_2_ex_is_iso_arr:
	+ assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	+ and "\<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L\<^sub>2 \<aa>\<^sub>P\<^sub>L\<^sub>2 \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
	+proof-
	+ interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	+ show ?thesis
	+ using that
	+ by
	+ (
	+ rule cat_coequalizer_ex_is_iso_arr
	+ [
	+ OF
	+ \<epsilon>.cat_coequalizer_2_is_cat_coequalizer
	+ \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	+ folded
	+ \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cat_parallel_2_commute
	+ ]
	+ )
	+qed
	+
	+lemma cat_coequalizer_2_ex_is_iso_arr':
	+ assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+proof-
	+ interpret \<epsilon>: is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
	+ interpret \<epsilon>': is_cat_coequalizer_2 \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
	+ show ?thesis
	+ using that
	+ by
	+ (
	+ rule cat_coequalizer_ex_is_iso_arr'
	+ [
	+ OF
	+ \<epsilon>.cat_coequalizer_2_is_cat_coequalizer
	+ \<epsilon>'.cat_coequalizer_2_is_cat_coequalizer,
	+ folded
	+ \<aa>\<^sub>P\<^sub>L\<^sub>2_def \<bb>\<^sub>P\<^sub>L\<^sub>2_def the_cat_parallel_2_def the_cat_parallel_2_commute
	+ ]
	+ )
	+qed
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma (in is_cat_equalizer_2) cat_eq_2_is_monic_arr:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : E \<mapsto>\<^sub>m\<^sub>o\<^sub>n\<^bsub>\<CC>\<^esub> \<aa>"
	+ by
	+ (
	+ rule is_cat_equalizer.cat_eq_is_monic_arr[
	+ OF cat_equalizer_2_is_cat_equalizer, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ )
	+
	+lemma (in is_cat_coequalizer_2) cat_coeq_2_is_epic_arr:
	+ "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : \<aa> \<mapsto>\<^sub>e\<^sub>p\<^sub>i\<^bsub>\<CC>\<^esub> E"
	+ by
	+ (
	+ rule is_cat_coequalizer.cat_coeq_is_epic_arr[
	+ OF cat_coequalizer_2_is_cat_coequalizer, folded \<aa>\<^sub>P\<^sub>L\<^sub>2_def
	+ ]
	+ )
	+
	+
	+
	+subsection\<open>Equalizer cone\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition ntcf_equalizer_base :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e =
	+ [
	+ (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x),
	+ cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E,
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>,
	+ \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L,
	+ \<CC>
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_equalizer_base_components:
	+ shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr> =
	+ (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x)"
	+ and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDom\<rparr> =
	+ cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E"
	+ and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTCod\<rparr> =
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>"
	+ and [cat_lim_cs_simps]:
	+ "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGDom\<rparr> = \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L"
	+ and [cat_lim_cs_simps]:
	+ "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding ntcf_equalizer_base_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_equalizer_base_components(1)
	+ \|vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]\|
	+ \|vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]\|
	+ \|app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]\|
	+
	+
	+subsubsection\<open>Equalizer cone is a cone\<close>
	+
	+lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
	+ assumes "e \<aa>\<^sub>P\<^sub>L\<^sub>2 : E \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
	+ and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 : E \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L\<^sub>2"
	+ and "e \<bb>\<^sub>P\<^sub>L\<^sub>2 = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L\<^sub>2"
	+ and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
	+ shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e :
	+ E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
	+ \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret par: cf_parallel_2 \<alpha> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>
	+ by (intro cf_parallel_2I cat_parallel_2I assms(5,6))
	+ (simp_all add: cat_parallel_cs_intros cat_cs_intros)
	+ show ?thesis
	+ proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	+ show "vfsequence (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e)"
	+ unfolding ntcf_equalizer_base_def by auto
	+ show "vcard (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e) = 5\<^sub>\<nat>"
	+ unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
	+ from assms(2) show
	+ "cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
	+ )
	+ from assms show
	+ "\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_intro: cat_parallel_cs_intros cat_small_cs_intros)
	+ show
	+ "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>i\<rparr> :
	+ cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>"
	+ if "i \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>" for i
	+ proof-
	+ from that assms(1,2,5,6) show ?thesis
	+ by (elim the_cat_parallel_2_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ qed
	+ show
	+ "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	+ cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
	+ \<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F \<CC> \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	+ ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
	+ if "f' : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<^esub> b'" for a' b' f'
	+ using that assms(1,2,5,6)
	+ by (elim par.the_cat_parallel_2_is_arrE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps
	+ cat_lim_cs_simps
	+ cat_parallel_cs_simps
	+ assms(3,4)[symmetric]
	+ cs_intro: cat_parallel_cs_intros
	+ )+
	+ qed
	+ (
	+ use assms(2) in
	+ \<open>
	+ cs_concl
	+ cs_intro: cat_lim_cs_intros cat_cs_intros
	+ cs_simp: cat_lim_cs_simps
	+ \<close>
	+ )+
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_IT.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_IT.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_IT.thy
	@@ -0,0 +1,691 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Initial and terminal objects as limits and colimits\<close>
	+theory CZH_UCAT_Limit_IT
	+ imports
	+ CZH_UCAT_Limit
	+ CZH_Elementary_Categories.CZH_ECAT_Comma
	+begin
	+
	+
	+
	+subsection\<open>Initial and terminal objects as limits/colimits of an empty diagram\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+text\<open>
	+See
	+\cite{noauthor_nlab_nodate}\footnote{
	+\url{https://ncatlab.org/nlab/show/initial+object}
	+}, \cite{noauthor_nlab_nodate}\footnote{
	+\url{https://ncatlab.org/nlab/show/terminal+object}
	+} and Chapter X-1 in \cite{mac_lane_categories_2010}.
	+\<close>
	+
	+locale is_cat_obj_empty_terminal = is_cat_limit \<alpha> cat_0 \<CC> \<open>cf_0 \<CC>\<close> z \<ZZ>
	+ for \<alpha> \<CC> z \<ZZ>
	+
	+syntax "_is_cat_obj_empty_terminal" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F :/ 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51] 51)
	+translations "\<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_empty_terminal \<alpha> \<CC> z \<ZZ>"
	+
	+locale is_cat_obj_empty_initial = is_cat_colimit \<alpha> cat_0 \<CC> \<open>cf_0 \<CC>\<close> z \<ZZ>
	+ for \<alpha> \<CC> z \<ZZ>
	+
	+syntax "_is_cat_obj_empty_initial" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 _ :/ 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51] 51)
	+translations "\<ZZ> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_empty_initial \<alpha> \<CC> z \<ZZ>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_obj_empty_terminal)
	+ is_cat_obj_empty_terminal_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	+ shows "\<ZZ> : z' <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_empty_terminal_axioms)
	+
	+mk_ide rf is_cat_obj_empty_terminal_def
	+ \|intro is_cat_obj_empty_terminalI\|
	+ \|dest is_cat_obj_empty_terminalD[dest]\|
	+ \|elim is_cat_obj_empty_terminalE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_empty_terminalD
	+
	+lemma (in is_cat_obj_empty_initial)
	+ is_cat_obj_empty_initial_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	+ shows "\<ZZ> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z' : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_empty_initial_axioms)
	+
	+mk_ide rf is_cat_obj_empty_initial_def
	+ \|intro is_cat_obj_empty_initialI\|
	+ \|dest is_cat_obj_empty_initialD[dest]\|
	+ \|elim is_cat_obj_empty_initialE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_empty_initialD
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op:
	+ "op_ntcf \<ZZ> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_obj_empty_initialI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<ZZ> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_empty_initial_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op'
	+
	+lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op:
	+ "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_obj_empty_terminalI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_empty_terminal_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op'
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_cat_obj_empty_terminal) cat_oet_ntcf_0: "\<ZZ> = ntcf_0 \<CC>"
	+ by (rule is_ntcf_is_ntcf_0_if_cat_0)
	+ (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+lemma (in is_cat_obj_empty_initial) cat_oei_ntcf_0: "\<ZZ> = ntcf_0 \<CC>"
	+ by (rule is_ntcf_is_ntcf_0_if_cat_0)
	+ (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+
	+subsubsection\<open>
	+Initial and terminal objects as limits/colimits of an empty diagram
	+are initial and terminal objects
	+\<close>
	+
	+lemma (in category) cat_obj_terminal_is_cat_obj_empty_terminal:
	+ assumes "obj_terminal \<CC> z"
	+ shows "ntcf_0 \<CC> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+
	+ from assms have z: "z \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ from z have [cat_cs_simps]: "cf_const cat_0 \<CC> z = cf_0 \<CC>"
	+ by (intro is_functor_is_cf_0_if_cat_0) (cs_concl cs_intro: cat_cs_intros)
	+ note obj_terminalD = obj_terminalD[OF assms]
	+
	+ show ?thesis
	+ proof
	+ (
	+ intro is_cat_obj_empty_terminalI is_cat_limitI is_cat_coneI,
	+ unfold cat_cs_simps
	+ )
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z \<and> u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	+ if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" for u' r'
	+ proof-
	+ interpret u': is_cat_cone \<alpha> r' cat_0 \<CC> \<open>cf_0 \<CC>\<close> u' by (rule that)
	+ from z have [cat_cs_simps]: "cf_const cat_0 \<CC> r' = cf_0 \<CC>"
	+ by (intro is_functor_is_cf_0_if_cat_0)
	+ (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ have u'_def: "u' = ntcf_0 \<CC>"
	+ by
	+ (
	+ rule is_ntcf_is_ntcf_0_if_cat_0[
	+ OF u'.is_ntcf_axioms, unfolded cat_cs_simps
	+ ]
	+ )
	+ from obj_terminalD(2)[OF u'.cat_cone_obj] obtain f'
	+ where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ and f'_unique: "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z \<Longrightarrow> f'' = f'"
	+ for f''
	+ by auto
	+ from f' have [cat_cs_simps]: "ntcf_const cat_0 \<CC> f' = ntcf_0 \<CC>"
	+ by (intro is_ntcf_is_ntcf_0_if_cat_0(1))
	+ (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show ?thesis
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show "u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: u'_def cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ fix f'' assume prems:
	+ "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> z" "u' = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f''"
	+ show "f'' = f'" by (rule f'_unique[OF prems(1)])
	+ qed (rule f')
	+ qed
	+ qed (cs_concl cs_simp: cat_cs_simps cs_intro: z cat_cs_intros)
	+
	+qed
	+
	+lemma (in category) cat_obj_initial_is_cat_obj_empty_initial:
	+ assumes "obj_initial \<CC> z"
	+ shows "ntcf_0 \<CC> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ have z: "obj_terminal (op_cat \<CC>) z" unfolding cat_op_simps by (rule assms)
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op
	+ [
	+ OF category.cat_obj_terminal_is_cat_obj_empty_terminal[
	+ OF category_op z, folded op_ntcf_ntcf_0
	+ ],
	+ unfolded cat_op_simps op_ntcf_ntcf_0
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_obj_empty_terminal) cat_oet_obj_terminal: "obj_terminal \<CC> z"
	+proof-
	+ show "obj_terminal \<CC> z"
	+ proof(rule obj_terminalI)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ have [cat_cs_simps]: "cf_const cat_0 \<CC> a = cf_0 \<CC>"
	+ by (rule is_functor_is_cf_0_if_cat_0)
	+ (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros prems)
	+ from prems have "ntcf_0 \<CC> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (intro is_cat_coneI)
	+ (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from cat_lim_ua_fo[OF this] obtain f'
	+ where f': "f' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ and "ntcf_0 \<CC> = \<ZZ> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'"
	+ and f'_unique:
	+ "\<lbrakk> f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> z; ntcf_0 \<CC> = \<ZZ> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f'' \<rbrakk> \<Longrightarrow>
	+ f'' = f'"
	+ for f''
	+ by metis
	+ show "\<exists>!f'. f' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ proof(intro ex1I)
	+ fix f'' assume prems': "f'' : a \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ from prems' have "ntcf_0 \<CC> = ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const cat_0 \<CC> f''"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from f'_unique[OF prems', unfolded cat_oet_ntcf_0, OF this]
	+ show "f'' = f'".
	+ qed (rule f')
	+ qed (rule cat_cone_obj)
	+qed
	+
	+lemma (in is_cat_obj_empty_initial) cat_oei_obj_initial: "obj_initial \<CC> z"
	+ by
	+ (
	+ rule is_cat_obj_empty_terminal.cat_oet_obj_terminal[
	+ OF is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op[
	+ OF is_cat_obj_empty_initial_axioms
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+
	+lemma (in category) cat_is_cat_obj_empty_terminal_obj_terminal_iff:
	+ "(ntcf_0 \<CC> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>1 0\<^sub>C\<^sub>F : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_terminal \<CC> z"
	+ using
	+ cat_obj_terminal_is_cat_obj_empty_terminal
	+ is_cat_obj_empty_terminal.cat_oet_obj_terminal
	+ by auto
	+
	+lemma (in category) cat_is_cat_obj_empty_initial_obj_initial_iff:
	+ "(ntcf_0 \<CC> : 0\<^sub>C\<^sub>F >\<^sub>C\<^sub>F\<^sub>.\<^sub>0 z : 0\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_initial \<CC> z"
	+ using
	+ cat_obj_initial_is_cat_obj_empty_initial
	+ is_cat_obj_empty_initial.cat_oei_obj_initial
	+ by auto
	+
	+
	+
	+subsection\<open>Initial cone and terminal cocone\<close>
	+
	+
	+subsubsection\<open>Definitions and elementary properties\<close>
	+
	+definition ntcf_initial :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_initial \<CC> z =
	+ [
	+ (\<lambda>b\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f. f : z \<mapsto>\<^bsub>\<CC>\<^esub> b),
	+ cf_const \<CC> \<CC> z,
	+ cf_id \<CC>,
	+ \<CC>,
	+ \<CC>
	+ ]\<^sub>\<circ>"
	+
	+definition ntcf_terminal :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_terminal \<CC> z =
	+ [
	+ (\<lambda>b\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f. f : b \<mapsto>\<^bsub>\<CC>\<^esub> z),
	+ cf_id \<CC>,
	+ cf_const \<CC> \<CC> z,
	+ \<CC>,
	+ \<CC>
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_initial_components:
	+ shows "ntcf_initial \<CC> z\<lparr>NTMap\<rparr> = (\<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f. f : z \<mapsto>\<^bsub>\<CC>\<^esub> c)"
	+ and "ntcf_initial \<CC> z\<lparr>NTDom\<rparr> = cf_const \<CC> \<CC> z"
	+ and "ntcf_initial \<CC> z\<lparr>NTCod\<rparr> = cf_id \<CC>"
	+ and "ntcf_initial \<CC> z\<lparr>NTDGDom\<rparr> = \<CC>"
	+ and "ntcf_initial \<CC> z\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding ntcf_initial_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+lemmas [cat_lim_cs_simps] = ntcf_initial_components(2-5)
	+
	+lemma ntcf_terminal_components:
	+ shows "ntcf_terminal \<CC> z\<lparr>NTMap\<rparr> = (\<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f. f : c \<mapsto>\<^bsub>\<CC>\<^esub> z)"
	+ and "ntcf_terminal \<CC> z\<lparr>NTDom\<rparr> = cf_id \<CC>"
	+ and "ntcf_terminal \<CC> z\<lparr>NTCod\<rparr> = cf_const \<CC> \<CC> z"
	+ and "ntcf_terminal \<CC> z\<lparr>NTDGDom\<rparr> = \<CC>"
	+ and "ntcf_terminal \<CC> z\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding ntcf_terminal_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+lemmas [cat_lim_cs_simps] = ntcf_terminal_components(2-5)
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma ntcf_initial_op[cat_op_simps]:
	+ "op_ntcf (ntcf_initial \<CC> z) = ntcf_terminal (op_cat \<CC>) z"
	+ unfolding
	+ ntcf_initial_def ntcf_terminal_def op_ntcf_def
	+ nt_field_simps cat_op_simps
	+ by (auto simp: nat_omega_simps cat_op_simps)
	+
	+lemma ntcf_cone_terminal_op[cat_op_simps]:
	+ "op_ntcf (ntcf_terminal \<CC> z) = ntcf_initial (op_cat \<CC>) z"
	+ unfolding
	+ ntcf_initial_def ntcf_terminal_def op_ntcf_def
	+ nt_field_simps cat_op_simps
	+ by (auto simp: nat_omega_simps cat_op_simps)
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_initial_components(1)
	+ \|vsv ntcf_initial_vsv[cat_lim_cs_intros]\|
	+ \|vdomain ntcf_initial_vdomain[cat_lim_cs_simps]\|
	+ \|app ntcf_initial_app\|
	+
	+mk_VLambda ntcf_terminal_components(1)
	+ \|vsv ntcf_terminal_vsv[cat_lim_cs_intros]\|
	+ \|vdomain ntcf_terminal_vdomain[cat_lim_cs_simps]\|
	+ \|app ntcf_terminal_app\|
	+
	+lemma (in category)
	+ assumes "obj_initial \<CC> z" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows ntcf_initial_NTMap_app_is_arr:
	+ "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and ntcf_initial_NTMap_app_unique:
	+ "\<And>f'. f' : z \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f' = ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+proof-
	+ from obj_initialD(2)[OF assms(1,2)] obtain f
	+ where f: "f : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and f_unique: "f' : z \<mapsto>\<^bsub>\<CC>\<^esub> c \<Longrightarrow> f' = f"
	+ for f'
	+ by auto
	+ show is_arr: "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ proof(cs_concl_step ntcf_initial_app, rule assms(2), rule theI)
	+ fix f' assume "f' : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ from f_unique[OF this] show "f' = f".
	+ qed (rule f)
	+ fix f' assume "f' : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ from f_unique[OF this, folded f_unique[OF is_arr]]
	+ show "f' = ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr>".
	+qed
	+
	+lemma (in category) ntcf_initial_NTMap_app_is_arr'[cat_lim_cs_intros]:
	+ assumes "obj_initial \<CC> z"
	+ and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<CC>' = \<CC>"
	+ and "z' = z"
	+ and "c' = c"
	+ shows "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z' \<mapsto>\<^bsub>\<CC>'\<^esub> c'"
	+ using assms(1,2)
	+ unfolding assms(3-5)
	+ by (rule ntcf_initial_NTMap_app_is_arr)
	+
	+lemma (in category)
	+ assumes "obj_terminal \<CC> z" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ shows ntcf_terminal_NTMap_app_is_arr:
	+ "ntcf_terminal \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ and ntcf_terminal_NTMap_app_unique:
	+ "\<And>f'. f' : c \<mapsto>\<^bsub>\<CC>\<^esub> z \<Longrightarrow> f' = ntcf_terminal \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+proof-
	+ from obj_terminalD(2)[OF assms(1,2)] obtain f
	+ where f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ and f_unique: "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> z \<Longrightarrow> f' = f"
	+ for f'
	+ by auto
	+ show is_arr: "ntcf_terminal \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ proof(cs_concl_step ntcf_terminal_app, rule assms(2), rule theI)
	+ fix f' assume "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ from f_unique[OF this] show "f' = f".
	+ qed (rule f)
	+ fix f' assume "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ from f_unique[OF this, folded f_unique[OF is_arr]]
	+ show "f' = ntcf_terminal \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr>".
	+qed
	+
	+lemma (in category) ntcf_terminal_NTMap_app_is_arr'[cat_lim_cs_intros]:
	+ assumes "obj_terminal \<CC> z"
	+ and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<CC>' = \<CC>"
	+ and "z' = z"
	+ and "c' = c"
	+ shows "ntcf_terminal \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : c' \<mapsto>\<^bsub>\<CC>'\<^esub> z'"
	+ using assms(1,2)
	+ unfolding assms(3-5)
	+ by (rule ntcf_terminal_NTMap_app_is_arr)
	+
	+
	+
	+subsection\<open>
	+Initial and terminal objects as limits/colimits of the identity functor
	+\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+text\<open>
	+See
	+\cite{noauthor_nlab_nodate}\footnote{
	+\url{https://ncatlab.org/nlab/show/initial+object}
	+}, \cite{noauthor_nlab_nodate}\footnote{
	+\url{https://ncatlab.org/nlab/show/terminal+object}
	+} and Chapter X-1 in \cite{mac_lane_categories_2010}.
	+\<close>
	+
	+locale is_cat_obj_id_initial = is_cat_limit \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> z \<ZZ> for \<alpha> \<CC> z \<ZZ>
	+
	+syntax "_is_cat_obj_id_initial" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C :/ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
	+translations "\<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_id_initial \<alpha> \<CC> z \<ZZ>"
	+
	+locale is_cat_obj_id_terminal = is_cat_colimit \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> z \<ZZ> for \<alpha> \<CC> z \<ZZ>
	+
	+syntax "_is_cat_obj_id_terminal" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 _ :/ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
	+translations "\<ZZ> : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_id_terminal \<alpha> \<CC> z \<ZZ>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_obj_id_initial)
	+ is_cat_obj_id_initial_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	+ shows "\<ZZ> : z' <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_id_initial_axioms)
	+
	+mk_ide rf is_cat_obj_id_initial_def
	+ \|intro is_cat_obj_id_initialI\|
	+ \|dest is_cat_obj_id_initialD[dest]\|
	+ \|elim is_cat_obj_id_initialE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_id_initialD
	+
	+lemma (in is_cat_obj_id_terminal)
	+ is_cat_obj_id_terminal_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "z' = z" and "\<CC>' = \<CC>"
	+ shows "\<ZZ> : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z' : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_id_terminal_axioms)
	+
	+mk_ide rf is_cat_obj_id_terminal_def
	+ \|intro is_cat_obj_id_terminalI\|
	+ \|dest is_cat_obj_id_terminalD[dest]\|
	+ \|elim is_cat_obj_id_terminalE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_id_terminalD
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_obj_id_initial) is_cat_obj_id_terminal_op:
	+ "op_ntcf \<ZZ> : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_obj_id_terminalI)
	+ (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	+
	+lemma (in is_cat_obj_id_initial) is_cat_obj_id_terminal_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<ZZ> : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_id_terminal_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_id_initial.is_cat_obj_id_terminal_op'
	+
	+lemma (in is_cat_obj_id_terminal) is_cat_obj_id_initial_op:
	+ "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_obj_id_initialI)
	+ (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)
	+
	+lemma (in is_cat_obj_id_terminal) is_cat_obj_id_initial_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_id_initial_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_id_terminal.is_cat_obj_id_initial_op'
	+
	+
	+subsubsection\<open>
	+Initial and terminal objects as limits/colimits are initial and terminal objects
	+\<close>
	+
	+lemma (in category) cat_obj_initial_is_cat_obj_id_initial:
	+ assumes "obj_initial \<CC> z"
	+ shows "ntcf_initial \<CC> z : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_cat_obj_id_initialI is_cat_limitI)
	+
	+ from assms have z: "z \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ note obj_initialD = obj_initialD[OF assms]
	+
	+ show "ntcf_initial \<CC> z : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ proof(intro is_cat_coneI is_ntcfI', unfold cat_lim_cs_simps)
	+ show "vfsequence (ntcf_initial \<CC> z)"
	+ unfolding ntcf_initial_def by auto
	+ show "vcard (ntcf_initial \<CC> z) = 5\<^sub>\<nat>"
	+ unfolding ntcf_initial_def by (simp add: nat_omega_simps)
	+ show "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_const \<CC> \<CC> z\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
	+ using that assms(1)
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
	+ )
	+ show
	+ "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<CC> \<CC> z\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	+ cf_id \<CC>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
	+ proof-
	+ from that assms(1) have
	+ "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> b"
	+ by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
	+ note [cat_cs_simps] = ntcf_initial_NTMap_app_unique[
	+ OF assms(1) cat_is_arrD(3)[OF that] this
	+ ]
	+ from that assms(1) show ?thesis
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
	+ )
	+ qed
	+ qed (use z in \<open>cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros\<close>)+
	+ then interpret i: is_cat_cone \<alpha> z \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>ntcf_initial \<CC> z\<close> .
	+
	+ fix u r assume "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ then interpret u: is_cat_cone \<alpha> r \<CC> \<CC> \<open>cf_id \<CC>\<close> u .
	+
	+ from obj_initialD(2)[OF u.cat_cone_obj] obtain f
	+ where f: "f : z \<mapsto>\<^bsub>\<CC>\<^esub> r" and f_unique: "f' : z \<mapsto>\<^bsub>\<CC>\<^esub> r \<Longrightarrow> f' = f" for f'
	+ by auto
	+ note u.cat_cone_Comp_commute[cat_cs_simps del]
	+ from u.ntcf_Comp_commute[OF f] f have "u\<lparr>NTMap\<rparr>\<lparr>r\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+ show "\<exists>!f'.
	+ f' : r \<mapsto>\<^bsub>\<CC>\<^esub> z \<and>
	+ u = ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ from f show "u\<lparr>NTMap\<rparr>\<lparr>z\<rparr> : r \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u = ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> (u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>)"
	+ proof(rule ntcf_eqI, rule u.is_ntcf_axioms)
	+ show "ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> (u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>) :
	+ cf_const \<CC> \<CC> r \<mapsto>\<^sub>C\<^sub>F cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from z have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> (u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>))\<lparr>NTMap\<rparr>) =
	+ \<CC>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u\<lparr>NTMap\<rparr> =
	+ (ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> (u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>))\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_rhs u.ntcf_NTMap_vdomain)
	+ fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ then have ic: "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from u.ntcf_Comp_commute[OF ic] ic have [cat_cs_simps]:
	+ "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) simp
	+ from prems z show "u\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	+ (ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> (u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>))\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (auto intro: cat_cs_intros)
	+ qed simp_all
	+ fix f' assume prems:
	+ "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ "u = ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> f'"
	+ from z have "ntcf_initial \<CC> z\<lparr>NTMap\<rparr>\<lparr>z\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ note [cat_cs_simps] = cat_obj_initial_CId[OF assms this, symmetric]
	+ from prems(2) have
	+ "u\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = (ntcf_initial \<CC> z \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<CC> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>z\<rparr>"
	+ by simp
	+ from this prems(1) show "f' = u\<lparr>NTMap\<rparr>\<lparr>z\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) simp
	+ qed
	+qed
	+
	+lemma (in category) cat_obj_terminal_is_cat_obj_id_terminal:
	+ assumes "obj_terminal \<CC> z"
	+ shows "ntcf_terminal \<CC> z : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ rule is_cat_obj_id_initial.is_cat_obj_id_terminal_op
	+ [
	+ OF category.cat_obj_initial_is_cat_obj_id_initial[
	+ OF category_op op_cat_obj_initial[THEN iffD2, OF assms(1)]
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+
	+lemma cat_cone_CId_obj_initial:
	+ assumes "\<ZZ> : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr>"
	+ shows "obj_initial \<CC> z"
	+proof(intro obj_initialI)
	+ interpret \<ZZ>: is_cat_cone \<alpha> z \<CC> \<CC> \<open>cf_id \<CC>\<close> \<ZZ> by (rule assms(1))
	+ show "z \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (cs_concl cs_intro: cat_cs_intros)
	+ fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ show "\<exists>!f. f : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ proof(intro ex1I)
	+ from prems show \<ZZ>c: "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ fix f assume prems': "f : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ from \<ZZ>.ntcf_Comp_commute[OF prems'] prems' \<ZZ>c show "f = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps assms(2) cs_intro: cat_cs_intros) simp
	+ qed
	+qed
	+
	+lemma cat_cocone_CId_obj_terminal:
	+ assumes "\<ZZ> : cf_id \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e z : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr>"
	+ shows "obj_terminal \<CC> z"
	+proof-
	+ interpret \<ZZ>: is_cat_cocone \<alpha> z \<CC> \<CC> \<open>cf_id \<CC>\<close> \<ZZ> by (rule assms(1))
	+ show ?thesis
	+ by
	+ (
	+ rule cat_cone_CId_obj_initial
	+ [
	+ OF \<ZZ>.is_cat_cone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps,
	+ OF assms(2)
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_obj_id_initial) cat_oii_obj_initial: "obj_initial \<CC> z"
	+proof(rule cat_cone_CId_obj_initial, rule is_cat_cone_axioms)
	+ from cat_lim_unique_cone'[OF is_cat_cone_axioms] obtain f
	+ where f: "f : z \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ and \<ZZ>'j: "\<And>j. j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ and f_unique:
	+ "\<lbrakk>
	+ f' : z \<mapsto>\<^bsub>\<CC>\<^esub> z;
	+ \<And>j. j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ for f'
	+ by metis
	+ have CId_z: "\<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ have "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr>" if "j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for j
	+ using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from f_unique[OF CId_z this] have CId_f: "\<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr> = f" .
	+ have \<ZZ>z: "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> z"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ have "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr>" if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	+ proof-
	+ from that have \<ZZ>c: "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : z \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ note cat_cone_Comp_commute[cat_cs_simps del]
	+ from ntcf_Comp_commute[OF \<ZZ>c] \<ZZ>c show
	+ "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = \<ZZ>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+ from f_unique[OF \<ZZ>z this] have "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = f" .
	+ with CId_f show "\<ZZ>\<lparr>NTMap\<rparr>\<lparr>z\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>z\<rparr>" by simp
	+qed
	+
	+lemma (in is_cat_obj_id_terminal) cat_oit_obj_terminal: "obj_terminal \<CC> z"
	+ by
	+ (
	+ rule is_cat_obj_id_initial.cat_oii_obj_initial[
	+ OF is_cat_obj_id_initial_op, unfolded cat_op_simps
	+ ]
	+ )
	+
	+lemma (in category) cat_is_cat_obj_id_initial_obj_initial_iff:
	+ "(ntcf_initial \<CC> z : z <\<^sub>C\<^sub>F\<^sub>.\<^sub>0 id\<^sub>C : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_initial \<CC> z"
	+ using
	+ cat_obj_initial_is_cat_obj_id_initial
	+ is_cat_obj_id_initial.cat_oii_obj_initial
	+ by auto
	+
	+lemma (in category) cat_is_cat_obj_id_terminal_obj_terminal_iff:
	+ "(ntcf_terminal \<CC> z : id\<^sub>C >\<^sub>C\<^sub>F\<^sub>.\<^sub>1 z : \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>) \<longleftrightarrow> obj_terminal \<CC> z"
	+ using
	+ cat_obj_terminal_is_cat_obj_id_terminal
	+ is_cat_obj_id_terminal.cat_oit_obj_terminal
	+ by auto
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Product.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Product.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Product.thy
	@@ -0,0 +1,971 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Products and coproducts as limits and colimits\<close>
	+theory CZH_UCAT_Limit_Product
	+ imports
	+ CZH_UCAT_Limit
	+ CZH_Elementary_Categories.CZH_ECAT_Discrete
	+begin
	+
	+
	+
	+subsection\<open>Product and coproduct\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+The definition of the product object is a specialization of the
	+definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
	+In the definition presented below, the discrete category that is used in the
	+definition presented in \cite{mac_lane_categories_2010} is parameterized by
	+an index set and the functor from the discrete category is
	+parameterized by a function from the index set to the set of
	+the objects of the category.
	+\<close>
	+
	+locale is_cat_obj_prod =
	+ is_cat_limit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> P \<pi> + cf_discrete \<alpha> I A \<CC>
	+ for \<alpha> I A \<CC> P \<pi>
	+
	+syntax "_is_cat_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_prod \<alpha> I A \<CC> P \<pi>"
	+
	+locale is_cat_obj_coprod =
	+ is_cat_colimit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> U \<pi> + cf_discrete \<alpha> I A \<CC>
	+ for \<alpha> I A \<CC> U \<pi>
	+
	+syntax "_is_cat_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_coprod \<alpha> I A \<CC> U \<pi>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_prod_axioms)
	+
	+mk_ide rf is_cat_obj_prod_def
	+ \|intro is_cat_obj_prodI\|
	+ \|dest is_cat_obj_prodD[dest]\|
	+ \|elim is_cat_obj_prodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_prodD
	+
	+lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_coprod_axioms)
	+
	+mk_ide rf is_cat_obj_coprod_def
	+ \|intro is_cat_obj_coprodI\|
	+ \|dest is_cat_obj_coprodD[dest]\|
	+ \|elim is_cat_obj_coprodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
	+ "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ using cf_discrete_vdomain_vsubset_Vset
	+ by (intro is_cat_obj_coprodI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_coprod_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'
	+
	+lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
	+ "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ using cf_discrete_vdomain_vsubset_Vset
	+ by (intro is_cat_obj_prodI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_prod_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'
	+
	+
	+subsubsection\<open>Universal property\<close>
	+
	+lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I A \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	+ by
	+ (
	+ rule cat_lim_unique_cone'[
	+ OF assms, unfolded the_cat_discrete_components(1)
	+ ]
	+ )
	+
	+lemma (in is_cat_obj_prod) cat_obj_prod_unique:
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
	+ by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])
	+
	+lemma (in is_cat_obj_prod) cat_obj_prod_unique':
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>i\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	+proof-
	+ interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(1))
	+ show ?thesis
	+ by
	+ (
	+ rule cat_lim_unique'[
	+ OF \<pi>'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
	+ assumes "\<pi>' : :\<rightarrow>: I A \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e U' : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	+ by
	+ (
	+ rule cat_colim_unique_cocone'[
	+ OF assms, unfolded the_cat_discrete_components(1)
	+ ]
	+ )
	+
	+lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
	+ assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> \<pi>' = ntcf_const (:\<^sub>C I) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	+ by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])
	+
	+lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
	+ assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
	+ by
	+ (
	+ rule cat_colim_unique'[
	+ OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
	+ ]
	+ )
	+
	+lemma cat_obj_prod_ex_is_iso_arr:
	+ assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f"
	+proof-
	+ interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr[
	+ OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_obj_prod_ex_is_iso_arr':
	+ assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P"
	+ and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+proof-
	+ interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr'[
	+ OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms,
	+ unfolded the_cat_discrete_components(1)
	+ ]
	+ )
	+qed
	+
	+lemma cat_obj_coprod_ex_is_iso_arr:
	+ assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C I) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	+proof-
	+ interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr[
	+ OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_obj_coprod_ex_is_iso_arr':
	+ assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'"
	+ and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
	+proof-
	+ interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr'[
	+ OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms,
	+ unfolded the_cat_discrete_components(1)
	+ ]
	+ )
	+qed
	+
	+
	+
	+subsection\<open>Small product and small coproduct\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+locale is_tm_cat_obj_prod =
	+ is_cat_limit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> P \<pi> + tm_cf_discrete \<alpha> I A \<CC>
	+ for \<alpha> I A \<CC> P \<pi>
	+
	+syntax "_is_tm_cat_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_obj_prod \<alpha> I A \<CC> P \<pi>"
	+
	+locale is_tm_cat_obj_coprod =
	+ is_cat_colimit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> U \<pi> + tm_cf_discrete \<alpha> I A \<CC>
	+ for \<alpha> I A \<CC> U \<pi>
	+
	+syntax "_is_tm_cat_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_tm_cat_obj_coprod \<alpha> I A \<CC> U \<pi>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_tm_cat_obj_prod) is_tm_cat_obj_prod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> A' : I' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_obj_prod_axioms)
	+
	+mk_ide rf is_tm_cat_obj_prod_def
	+ \|intro is_tm_cat_obj_prodI\|
	+ \|dest is_tm_cat_obj_prodD[dest]\|
	+ \|elim is_tm_cat_obj_prodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_tm_cat_obj_prodD
	+
	+lemma (in is_tm_cat_obj_coprod)
	+ is_tm_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> U' : I' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_obj_coprod_axioms)
	+
	+mk_ide rf is_tm_cat_obj_coprod_def
	+ \|intro is_tm_cat_obj_coprodI\|
	+ \|dest is_tm_cat_obj_coprodD[dest]\|
	+ \|elim is_tm_cat_obj_coprodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_tm_cat_obj_coprodD
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+sublocale is_tm_cat_obj_prod \<subseteq> is_cat_obj_prod
	+ by
	+ (
	+ intro is_cat_obj_prodI,
	+ rule is_cat_limit_axioms,
	+ rule cf_discrete_axioms
	+ )
	+
	+lemmas (in is_tm_cat_obj_prod) tm_cat_obj_prod_is_cat_obj_prod =
	+ is_cat_obj_prod_axioms
	+
	+sublocale is_tm_cat_obj_coprod \<subseteq> is_cat_obj_coprod
	+ by
	+ (
	+ intro is_cat_obj_coprodI,
	+ rule is_cat_colimit_axioms,
	+ rule cf_discrete_axioms
	+ )
	+
	+lemmas (in is_tm_cat_obj_coprod) tm_cat_obj_coprod_is_cat_obj_coprod =
	+ is_cat_obj_coprod_axioms
	+
	+sublocale is_tm_cat_obj_prod \<subseteq> is_tm_cat_limit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> P \<pi>
	+ by
	+ (
	+ intro
	+ is_tm_cat_limitI
	+ is_tm_cat_coneI
	+ is_ntcf_axioms
	+ tm_cf_discrete_the_cf_discrete_is_tm_functor
	+ cat_cone_obj
	+ cat_lim_ua_fo
	+ )
	+
	+lemmas (in is_tm_cat_obj_prod) tm_cat_obj_prod_is_tm_cat_limit =
	+ is_tm_cat_limit_axioms
	+
	+sublocale is_tm_cat_obj_coprod \<subseteq> is_tm_cat_colimit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> U \<pi>
	+ by
	+ (
	+ intro
	+ is_tm_cat_colimitI
	+ is_tm_cat_coconeI
	+ is_ntcf_axioms
	+ tm_cf_discrete_the_cf_discrete_is_tm_functor
	+ cat_cocone_obj
	+ cat_colim_ua_of
	+ )
	+
	+lemmas (in is_tm_cat_obj_coprod) tm_cat_obj_coprod_is_tm_cat_colimit =
	+ is_tm_cat_colimit_axioms
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_tm_cat_obj_prod) is_tm_cat_obj_coprod_op:
	+ "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ using cf_discrete_vdomain_vsubset_Vset
	+ by (intro is_tm_cat_obj_coprodI)
	+ (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
	+
	+lemma (in is_tm_cat_obj_prod) is_tm_cat_obj_coprod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_obj_coprod_op)
	+
	+lemmas [cat_op_intros] = is_tm_cat_obj_prod.is_tm_cat_obj_coprod_op'
	+
	+lemma (in is_tm_cat_obj_coprod) is_tm_cat_obj_coprod_op:
	+ "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ using cf_discrete_vdomain_vsubset_Vset
	+ by (intro is_tm_cat_obj_prodI)
	+ (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
	+
	+lemma (in is_tm_cat_obj_coprod) is_tm_cat_obj_prod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_tm_cat_obj_coprod_op)
	+
	+lemmas [cat_op_intros] = is_tm_cat_obj_coprod.is_tm_cat_obj_prod_op'
	+
	+
	+
	+subsection\<open>Finite product and finite coproduct\<close>
	+
	+locale is_cat_finite_obj_prod = is_cat_obj_prod \<alpha> I A \<CC> P \<pi>
	+ for \<alpha> I A \<CC> P \<pi> +
	+ assumes cat_fin_obj_prod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>"
	+
	+syntax "_is_cat_finite_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_finite_obj_prod \<alpha> I A \<CC> P \<pi>"
	+
	+locale is_cat_finite_obj_coprod = is_cat_obj_coprod \<alpha> I A \<CC> U \<pi>
	+ for \<alpha> I A \<CC> U \<pi> +
	+ assumes cat_fin_obj_coprod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>"
	+
	+syntax "_is_cat_finite_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_finite_obj_coprod \<alpha> I A \<CC> U \<pi>"
	+
	+lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
	+ using cat_fin_obj_prod_index_in_\<omega> by auto
	+
	+sublocale is_cat_finite_obj_prod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
	+ by (intro finite_categoryI')
	+ (
	+ auto
	+ simp: NTDom.HomDom.category_axioms the_cat_discrete_components
	+ intro!: cat_fin_obj_prod_index_vfinite
	+ )
	+
	+lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
	+ "vfinite I"
	+ using cat_fin_obj_coprod_index_in_\<omega> by auto
	+
	+sublocale is_cat_finite_obj_coprod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
	+ by (intro finite_categoryI')
	+ (
	+ auto
	+ simp: NTDom.HomDom.category_axioms the_cat_discrete_components
	+ intro!: cat_fin_obj_coprod_index_vfinite
	+ )
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_finite_obj_prod)
	+ is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_finite_obj_prod_axioms)
	+
	+mk_ide rf
	+ is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
	+ \|intro is_cat_finite_obj_prodI\|
	+ \|dest is_cat_finite_obj_prodD[dest]\|
	+ \|elim is_cat_finite_obj_prodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD
	+
	+lemma (in is_cat_finite_obj_coprod)
	+ is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>"
	+ shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_finite_obj_coprod_axioms)
	+
	+mk_ide rf
	+ is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
	+ \|intro is_cat_finite_obj_coprodI\|
	+ \|dest is_cat_finite_obj_coprodD[dest]\|
	+ \|elim is_cat_finite_obj_coprodE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
	+ "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_finite_obj_coprodI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps
	+ cs_intro: cat_fin_obj_prod_index_in_\<omega> cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_finite_obj_coprod_op)
	+
	+lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'
	+
	+lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
	+ "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_finite_obj_prodI)
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_op_simps
	+ cs_intro: cat_fin_obj_coprod_index_in_\<omega> cat_cs_intros cat_op_intros
	+ )
	+
	+lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_finite_obj_prod_op)
	+
	+lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'
	+
	+
	+
	+subsection\<open>Product and coproduct of two objects\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+locale is_cat_obj_prod_2 = is_cat_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	+ for \<alpha> a b \<CC> P \<pi>
	+
	+syntax "_is_cat_obj_prod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {_,_} :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi>"
	+
	+locale is_cat_obj_coprod_2 = is_cat_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	+ for \<alpha> a b \<CC> P \<pi>
	+
	+syntax "_is_cat_obj_coprod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ {_,_} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> _ :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
	+translations "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi>"
	+
	+abbreviation proj_fst where "proj_fst \<pi> \<equiv> vpfst (\<pi>\<lparr>NTMap\<rparr>)"
	+abbreviation proj_snd where "proj_snd \<pi> \<equiv> vpsnd (\<pi>\<lparr>NTMap\<rparr>)"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>"
	+ shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a',b'} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_prod_2_axioms)
	+
	+mk_ide rf is_cat_obj_prod_2_def
	+ \|intro is_cat_obj_prod_2I\|
	+ \|dest is_cat_obj_prod_2D[dest]\|
	+ \|elim is_cat_obj_prod_2E[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D
	+
	+lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>"
	+ shows "\<pi> : {a',b'} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_coprod_2_axioms)
	+
	+mk_ide rf is_cat_obj_coprod_2_def
	+ \|intro is_cat_obj_coprod_2I\|
	+ \|dest is_cat_obj_coprod_2D[dest]\|
	+ \|elim is_cat_obj_coprod_2E[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
	+ "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])
	+
	+lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_coprod_2_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'
	+
	+lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
	+ "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])
	+
	+lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_obj_prod_2_op)
	+
	+lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'
	+
	+
	+text\<open>Product/coproduct of two objects is a finite product/coproduct.\<close>
	+
	+sublocale is_cat_obj_prod_2 \<subseteq> is_cat_finite_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	+proof(intro is_cat_finite_obj_prodI)
	+ show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	+qed (cs_concl cs_shallow cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
	+
	+sublocale is_cat_obj_coprod_2 \<subseteq> is_cat_finite_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
	+proof(intro is_cat_finite_obj_coprodI)
	+ show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
	+qed (cs_concl cs_shallow cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
	+ shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+proof-
	+ have 0: "0 \<in>\<^sub>\<circ> 2\<^sub>\<nat>" and 1: "1\<^sub>\<nat> \<in>\<^sub>\<circ> 2\<^sub>\<nat>" by simp_all
	+ show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ by
	+ (
	+ intro
	+ cf_discrete_selector_vrange[OF 0, simplified]
	+ cf_discrete_selector_vrange[OF 1, simplified]
	+ )+
	+qed
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj
	+
	+lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
	+ shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ by
	+ (
	+ intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
	+ OF is_cat_obj_prod_2_op, unfolded cat_op_simps
	+ ]
	+ )+
	+
	+lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj
	+
	+
	+text\<open>Utilities/help lemmas.\<close>
	+
	+lemma helper_I2_proj_fst_proj_snd_iff:
	+ "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<longleftrightarrow>
	+ (proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and> proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
	+ unfolding two by auto
	+
	+lemma helper_I2_proj_fst_proj_snd_iff':
	+ "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>) \<longleftrightarrow>
	+ (proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and> proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>)"
	+ unfolding two by auto
	+
	+
	+subsubsection\<open>Universal property\<close>
	+
	+lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	+ proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	+ proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by
	+ (
	+ rule cat_obj_prod_unique_cone'[
	+ OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
	+ ]
	+ )
	+
	+lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f'"
	+ by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])
	+
	+lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
	+ assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	+ proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	+ proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by
	+ (
	+ rule cat_obj_prod_unique'[
	+ OF is_cat_obj_prod_2D[OF assms],
	+ unfolded helper_I2_proj_fst_proj_snd_iff
	+ ]
	+ )
	+
	+lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
	+ assumes "\<pi>' : :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e P' : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
	+ proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
	+ proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
	+ by
	+ (
	+ rule cat_obj_coprod_unique_cocone'[
	+ OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
	+ ]
	+ )
	+
	+lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
	+ assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and> \<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	+ by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])
	+
	+lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
	+ assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows
	+ "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
	+ proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
	+ proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
	+ by
	+ (
	+ rule cat_obj_coprod_unique'[
	+ OF is_cat_obj_coprod_2D[OF assms],
	+ unfolded helper_I2_proj_fst_proj_snd_iff'
	+ ]
	+ )
	+
	+lemma cat_obj_prod_2_ex_is_iso_arr:
	+ assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f"
	+proof-
	+ interpret \<pi>: is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_prod_2 \<alpha> a b \<CC> P' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_obj_prod_ex_is_iso_arr[
	+ OF \<pi>.is_cat_obj_prod_axioms \<pi>'.is_cat_obj_prod_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_obj_coprod_2_ex_is_iso_arr:
	+ assumes "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
	+proof-
	+ interpret \<pi>: is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi> by (rule assms(1))
	+ interpret \<pi>': is_cat_obj_coprod_2 \<alpha> a b \<CC> U' \<pi>' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_obj_coprod_ex_is_iso_arr[
	+ OF \<pi>.is_cat_obj_coprod_axioms \<pi>'.is_cat_obj_coprod_axioms
	+ ]
	+ )
	+qed
	+
	+
	+
	+subsection\<open>Projection cone\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition ntcf_obj_prod_base :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "ntcf_obj_prod_base \<CC> I F P f =
	+ [(\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j), cf_const (:\<^sub>C I) \<CC> P, :\<rightarrow>: I F \<CC>, :\<^sub>C I, \<CC>]\<^sub>\<circ>"
	+
	+definition ntcf_obj_coprod_base :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "ntcf_obj_coprod_base \<CC> I F P f =
	+ [(\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j), :\<rightarrow>: I F \<CC>, cf_const (:\<^sub>C I) \<CC> P, :\<^sub>C I, \<CC>]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_obj_prod_base_components:
	+ shows "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr> = (\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j)"
	+ and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDom\<rparr> = cf_const (:\<^sub>C I) \<CC> P"
	+ and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTCod\<rparr> = :\<rightarrow>: I F \<CC>"
	+ and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	+ and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding ntcf_obj_prod_base_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+lemma ntcf_obj_coprod_base_components:
	+ shows "ntcf_obj_coprod_base \<CC> I F P f\<lparr>NTMap\<rparr> = (\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j)"
	+ and "ntcf_obj_coprod_base \<CC> I F P f\<lparr>NTDom\<rparr> = :\<rightarrow>: I F \<CC>"
	+ and "ntcf_obj_coprod_base \<CC> I F P f\<lparr>NTCod\<rparr> = cf_const (:\<^sub>C I) \<CC> P"
	+ and "ntcf_obj_coprod_base \<CC> I F P f\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	+ and "ntcf_obj_coprod_base \<CC> I F P f\<lparr>NTDGCod\<rparr> = \<CC>"
	+ unfolding ntcf_obj_coprod_base_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in cf_discrete) op_ntcf_ntcf_obj_coprod_base[cat_op_simps]:
	+ "op_ntcf (ntcf_obj_coprod_base \<CC> I F P f) =
	+ ntcf_obj_prod_base (op_cat \<CC>) I F P f"
	+proof-
	+ note [cat_op_simps] = the_cat_discrete_op[OF cf_discrete_vdomain_vsubset_Vset]
	+ show ?thesis
	+ unfolding
	+ ntcf_obj_prod_base_def ntcf_obj_coprod_base_def op_ntcf_def nt_field_simps
	+ by (simp add: nat_omega_simps cat_op_simps)
	+qed
	+
	+lemma (in cf_discrete) op_ntcf_ntcf_obj_prod_base[cat_op_simps]:
	+ "op_ntcf (ntcf_obj_prod_base \<CC> I F P f) =
	+ ntcf_obj_coprod_base (op_cat \<CC>) I F P f"
	+proof-
	+ note [cat_op_simps] = the_cat_discrete_op[OF cf_discrete_vdomain_vsubset_Vset]
	+ show ?thesis
	+ unfolding
	+ ntcf_obj_prod_base_def ntcf_obj_coprod_base_def op_ntcf_def nt_field_simps
	+ by (simp add: nat_omega_simps cat_op_simps)
	+qed
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_obj_prod_base_components(1)
	+ \|vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]\|
	+
	+mk_VLambda ntcf_obj_coprod_base_components(1)
	+ \|vsv ntcf_obj_coprod_base_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_obj_coprod_base_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_obj_coprod_base_NTMap_app[cat_cs_simps]\|
	+
	+
	+subsubsection\<open>Projection natural transformation is a cone\<close>
	+
	+lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
	+ assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
	+ shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
	+ from assms(2) have [cat_cs_intros]:
	+ "\<lbrakk> a \<in>\<^sub>\<circ> I; P' = P; Fa = F a \<rbrakk> \<Longrightarrow> f a : P' \<mapsto>\<^bsub>\<CC>\<^esub> Fa" for a P' Fa
	+ by simp
	+ show "vfsequence (ntcf_obj_prod_base \<CC> I F P f)"
	+ unfolding ntcf_obj_prod_base_def by auto
	+ show "vcard (ntcf_obj_prod_base \<CC> I F P f) = 5\<^sub>\<nat>"
	+ unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
	+ from assms show "cf_const (:\<^sub>C I) \<CC> P : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by
	+ (
	+ cs_concl
	+ cs_intro:
	+ cf_discrete_vdomain_vsubset_Vset
	+ cat_discrete_cs_intros
	+ cat_cs_intros
	+ )
	+ show ":\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_shallow cs_intro: cat_discrete_cs_intros)
	+ show "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_const (:\<^sub>C I) \<CC> P\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> :\<rightarrow>: I F \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>" for a
	+ proof-
	+ from that have "a \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
	+ from that this show ?thesis
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
	+ )
	+ qed
	+ show
	+ "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
	+ cf_const (:\<^sub>C I) \<CC> P\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
	+ :\<rightarrow>: I F \<CC>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "g : a \<mapsto>\<^bsub>:\<^sub>C I\<^esub> b" for a b g
	+ proof-
	+ note g = the_cat_discrete_is_arrD[OF that]
	+ from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
	+ unfolding g(7-9)
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_discrete_cs_simps
	+ cs_intro:
	+ cf_discrete_vdomain_vsubset_Vset
	+ cat_cs_intros cat_discrete_cs_intros
	+ )
	+ qed
	+qed
	+ (
	+ auto simp:
	+ assms
	+ ntcf_obj_prod_base_components
	+ tm_cf_discrete_the_cf_discrete_is_tm_functor
	+ )
	+
	+lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_coprod_base_is_cat_cocone:
	+ assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : F a \<mapsto>\<^bsub>\<CC>\<^esub> P"
	+ shows "ntcf_obj_coprod_base \<CC> I F P f :
	+ :\<rightarrow>: I F \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e P : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ note [cat_op_simps] =
	+ the_cat_discrete_op[OF cf_discrete_vdomain_vsubset_Vset]
	+ cf_discrete.op_ntcf_ntcf_obj_prod_base[OF cf_discrete_op]
	+ cf_discrete.cf_discrete_the_cf_discrete_op[OF cf_discrete_op]
	+ have "op_ntcf (ntcf_obj_coprod_base \<CC> I F P f) :
	+ P <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf (:\<rightarrow>: I F \<CC>) : op_cat (:\<^sub>C I) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ unfolding cat_op_simps
	+ by
	+ (
	+ rule tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[
	+ OF tm_cf_discrete_op, unfolded cat_op_simps, OF assms
	+ ]
	+ )
	+ from is_cat_cone.is_cat_cocone_op[OF this, unfolded cat_op_simps]
	+ show ?thesis .
	+qed
	+
	+lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
	+ assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
	+ and "\<And>u' r'.
	+ \<lbrakk> u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow>
	+ \<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
	+ u' = ntcf_obj_prod_base \<CC> I F P f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
	+ shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof
	+ (
	+ intro
	+ is_cat_obj_prodI
	+ is_cat_limitI
	+ tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified]
	+ assms(1,3)
	+ )
	+ show "cf_discrete \<alpha> I F \<CC>"
	+ by (cs_concl cs_shallow cs_intro: cat_small_discrete_cs_intros)
	+qed
	+
	+lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_coprod_base_is_cat_obj_coprod:
	+ assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : F a \<mapsto>\<^bsub>\<CC>\<^esub> P"
	+ and "\<And>u' r'. \<lbrakk> u' : :\<rightarrow>: I F \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow>
	+ \<exists>!f'.
	+ f' : P \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and>
	+ u' = ntcf_const (:\<^sub>C I) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_obj_coprod_base \<CC> I F P f"
	+ shows "ntcf_obj_coprod_base \<CC> I F P f : F >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ (is \<open>?nc : F >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	+proof-
	+ let ?np = \<open>ntcf_obj_prod_base (op_cat \<CC>) I F P f\<close>
	+ interpret is_cat_cocone \<alpha> P \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I F \<CC>\<close> ?nc
	+ by (intro tm_cf_discrete_ntcf_obj_coprod_base_is_cat_cocone[OF assms(1,2)])
	+ note [cat_op_simps] =
	+ the_cat_discrete_op[OF cf_discrete_vdomain_vsubset_Vset]
	+ cf_discrete.op_ntcf_ntcf_obj_prod_base[OF cf_discrete_op]
	+ cf_discrete.cf_discrete_the_cf_discrete_op[OF cf_discrete_op]
	+ have "\<exists>!f'.
	+ f' : P \<mapsto>\<^bsub>\<CC>\<^esub> r \<and>
	+ u = ?np \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (op_cat \<CC>) f'"
	+ if "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F (op_cat \<CC>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>" for u r
	+ proof-
	+ interpret u: is_cat_cone \<alpha> r \<open>:\<^sub>C I\<close> \<open>op_cat \<CC>\<close> \<open>:\<rightarrow>: I F (op_cat \<CC>)\<close> u
	+ by (rule that)
	+ from assms(3)[OF u.is_cat_cocone_op[unfolded cat_op_simps]] obtain g
	+ where g: "g : P \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ and op_u: "op_ntcf u = ntcf_const (:\<^sub>C I) \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?nc"
	+ and g_unique:
	+ "\<lbrakk> g' : P \<mapsto>\<^bsub>\<CC>\<^esub> r; op_ntcf u = ntcf_const (:\<^sub>C I) \<CC> g' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?nc \<rbrakk> \<Longrightarrow>
	+ g' = g"
	+ for g'
	+ by metis
	+ show ?thesis
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ from op_u have
	+ "op_ntcf (op_ntcf u) = op_ntcf (ntcf_const (:\<^sub>C I) \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?nc)"
	+ by simp
	+ from this g show "u = ?np \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (op_cat \<CC>) g"
	+ by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	+ fix g' assume prems:
	+ "g' : P \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ "u = ?np \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (op_cat \<CC>) g'"
	+ from prems(2) have
	+ "op_ntcf u = op_ntcf (?np \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (op_cat \<CC>) g')"
	+ by simp
	+ from this prems(1) g have "op_ntcf u = ntcf_const (:\<^sub>C I) \<CC> g' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?nc"
	+ by
	+ (
	+ subst (asm)
	+ the_cat_discrete_op[OF cf_discrete_vdomain_vsubset_Vset, symmetric]
	+ )
	+ (
	+ cs_prems
	+ cs_simp:
	+ cat_op_simps
	+ op_ntcf_ntcf_vcomp[symmetric]
	+ is_ntcf.ntcf_op_ntcf_op_ntcf
	+ op_ntcf_ntcf_obj_coprod_base[symmetric]
	+ op_ntcf_ntcf_const[symmetric]
	+ cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ from g_unique[OF prems(1) this] show "g' = g" .
	+ qed (rule g)
	+ qed
	+ from is_cat_obj_prod.is_cat_obj_coprod_op
	+ [
	+ OF tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod
	+ [
	+ OF tm_cf_discrete_op,
	+ unfolded cat_op_simps,
	+ OF assms(1,2) this,
	+ folded op_ntcf_ntcf_obj_coprod_base
	+ ],
	+ unfolded cat_op_simps
	+ ]
	+ show "?nc : F >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>".
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Pullback.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Pullback.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit_Pullback.thy
	@@ -0,0 +1,564 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Pullbacks and pushouts as limits and colimits\<close>
	+theory CZH_UCAT_Limit_Pullback
	+ imports
	+ CZH_UCAT_Limit
	+ CZH_Elementary_Categories.CZH_ECAT_SS
	+begin
	+
	+
	+
	+subsection\<open>Pullback and pushout\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>
	+The definitions and the elementary properties of the pullbacks and the
	+pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in
	+\cite{mac_lane_categories_2010}.
	+\<close>
	+
	+locale is_cat_pullback =
	+ is_cat_limit \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x +
	+ cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
	+ for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x
	+
	+syntax "_is_cat_pullback" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b _\<rightarrow>_\<rightarrow>_\<leftarrow>_\<leftarrow>_ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
	+translations "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
	+
	+locale is_cat_pushout =
	+ is_cat_colimit \<alpha> \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x +
	+ cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
	+ for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x
	+
	+syntax "_is_cat_pushout" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ (\<open>(_ :/ _\<leftarrow>_\<leftarrow>_\<rightarrow>_\<rightarrow>_ >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
	+translations "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons>
	+ "CONST is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
	+
	+
	+text\<open>Rules.\<close>
	+
	+lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "\<aa>' = \<aa>"
	+ and "\<gg>' = \<gg>"
	+ and "\<oo>' = \<oo>"
	+ and "\<ff>' = \<ff>"
	+ and "\<bb>' = \<bb>"
	+ and "\<CC>' = \<CC>"
	+ and "X' = X"
	+ shows "x : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>'\<rightarrow>\<gg>'\<rightarrow>\<oo>'\<leftarrow>\<ff>'\<leftarrow>\<bb>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_pullback_axioms)
	+
	+mk_ide rf is_cat_pullback_def
	+ \|intro is_cat_pullbackI\|
	+ \|dest is_cat_pullbackD[dest]\|
	+ \|elim is_cat_pullbackE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_pullbackD
	+
	+lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
	+ assumes "\<alpha>' = \<alpha>"
	+ and "\<aa>' = \<aa>"
	+ and "\<gg>' = \<gg>"
	+ and "\<oo>' = \<oo>"
	+ and "\<ff>' = \<ff>"
	+ and "\<bb>' = \<bb>"
	+ and "\<CC>' = \<CC>"
	+ and "X' = X"
	+ shows "x : \<aa>'\<leftarrow>\<gg>'\<leftarrow>\<oo>'\<rightarrow>\<ff>'\<rightarrow>\<bb>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_pushout_axioms)
	+
	+mk_ide rf is_cat_pushout_def
	+ \|intro is_cat_pushoutI\|
	+ \|dest is_cat_pushoutD[dest]\|
	+ \|elim is_cat_pushoutE[elim]\|
	+
	+lemmas [cat_lim_cs_intros] = is_cat_pushoutD
	+
	+
	+text\<open>Duality.\<close>
	+
	+lemma (in is_cat_pullback) is_cat_pushout_op:
	+ "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_pushoutI)
	+ (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+
	+
	+lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_pushout_op)
	+
	+lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'
	+
	+lemma (in is_cat_pushout) is_cat_pullback_op:
	+ "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ by (intro is_cat_pullbackI)
	+ (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)+
	+
	+lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
	+ assumes "\<CC>' = op_cat \<CC>"
	+ shows "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
	+ unfolding assms by (rule is_cat_pullback_op)
	+
	+lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'
	+
	+
	+text\<open>Elementary properties.\<close>
	+
	+lemma cat_cone_cospan:
	+ assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	+ shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+proof-
	+ interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	+ by (rule assms(1))
	+ interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	+ have \<gg>\<^sub>S\<^sub>S: "\<gg>\<^sub>S\<^sub>S : \<aa>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S" and \<ff>\<^sub>S\<^sub>S: "\<ff>\<^sub>S\<^sub>S : \<bb>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S"
	+ by (cs_concl cs_intro: cat_ss_cs_intros)+
	+ note x.cat_cone_Comp_commute[cat_cs_simps del]
	+ from x.ntcf_Comp_commute[OF \<gg>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show
	+ "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ moreover from x.ntcf_Comp_commute[OF \<ff>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show
	+ "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ ultimately show "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>" by simp
	+qed
	+
	+lemma (in is_cat_pullback) cat_pb_cone_cospan:
	+ shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ by (all\<open>rule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]\<close>)
	+
	+lemma cat_cocone_span:
	+ assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	+ shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+proof-
	+ interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	+ by (rule assms(1))
	+ interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	+ note op =
	+ cat_cone_cospan
	+ [
	+ OF
	+ x.is_cat_cone_op[unfolded cat_op_simps]
	+ span.cf_scospan_op,
	+ unfolded cat_op_simps
	+ ]
	+ from op(1) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_ss_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros cat_ss_cs_intros
	+ )
	+ moreover from op(2) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_ss_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros cat_ss_cs_intros
	+ )
	+ ultimately show "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>" by auto
	+qed
	+
	+lemma (in is_cat_pushout) cat_po_cocone_span:
	+ shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
	+ by (all\<open>rule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]\<close>)
	+
	+
	+subsubsection\<open>Universal property\<close>
	+
	+lemma is_cat_pullbackI':
	+ assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	+ and "\<And>x' X'. x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'.
	+ f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ shows "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof(intro is_cat_pullbackI is_cat_limitI)
	+
	+ show "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule assms(1))
	+ interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	+ by (rule assms(1))
	+ show "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>" by (rule assms(2))
	+ interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	+
	+ fix u' r' assume prems:
	+ "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+
	+ interpret u': is_cat_cone \<alpha> r' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> u'
	+ by (rule prems)
	+
	+ from assms(3)[OF prems] obtain f'
	+ where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	+ and u'_\<aa>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ and u'_\<bb>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ and unique_f': "\<And>f''.
	+ \<lbrakk>
	+ f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X;
	+ u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'';
	+ u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
	+ \<rbrakk> \<Longrightarrow> f'' = f'"
	+ by metis
	+
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+
	+ show "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	+ proof(rule ntcf_eqI)
	+ show "u' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule u'.is_ntcf_axioms)
	+ from f' show
	+ "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f' :
	+ cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
	+ \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from f' have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
	+ fix a assume prems': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ from this f' x.is_ntcf_axioms show
	+ "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by (elim the_cat_scospan_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_cs_simps cat_ss_cs_simps
	+ u'_\<bb>\<^sub>S\<^sub>S u'_\<aa>\<^sub>S\<^sub>S
	+ cat_cone_cospan(1)[OF assms(1,2)]
	+ cat_cone_cospan(1)[OF prems assms(2)]
	+ cs_intro: cat_cs_intros cat_ss_cs_intros
	+ )+
	+ qed (cs_concl cs_intro: cat_cs_intros \| auto)+
	+ qed simp_all
	+
	+ fix f'' assume prems:
	+ "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X" "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
	+ have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_intro: cat_ss_cs_intros)+
	+ have "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
	+ proof-
	+ from prems(2) have
	+ "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by simp
	+ from this that prems(1) show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+ from unique_f'[OF prems(1) this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S]] show "f'' = f'".
	+
	+ qed (intro f')
	+
	+qed
	+
	+lemma is_cat_pushoutI':
	+ assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
	+ and "\<And>x' X'. x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
	+ \<exists>!f'.
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ shows "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+proof-
	+ interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
	+ by (rule assms(1))
	+ interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
	+ have assms_3':
	+ "\<exists>!f'.
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
	+ if "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
	+ for x' X'
	+ proof-
	+ from that(1) have [cat_op_simps]:
	+ "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ for f'
	+ by (intro iffI conjI; (elim conjE)?)
	+ (
	+ cs_concl
	+ cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_ss_cs_intros
	+ )+
	+ interpret x':
	+ is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<open>op_cat \<CC>\<close> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<close> x'
	+ by (rule that)
	+ show ?thesis
	+ unfolding cat_op_simps
	+ by
	+ (
	+ rule assms(3)[
	+ OF x'.is_cat_cocone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+ qed
	+ interpret op_x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<open>op_cat \<CC>\<close> X \<open>op_ntcf x\<close>
	+ using
	+ is_cat_pullbackI'
	+ [
	+ OF x.is_cat_cone_op[unfolded cat_op_simps]
	+ span.cf_scospan_op,
	+ unfolded cat_op_simps,
	+ OF assms_3'
	+ ]
	+ by simp
	+ show "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
	+qed
	+
	+lemma (in is_cat_pullback) cat_pb_unique_cone:
	+ assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+ interpret x': is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x'
	+ by (rule assms)
	+ from cat_lim_ua_fo[OF assms] obtain f'
	+ where f': "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	+ and x'_def: "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	+ and unique_f': "\<And>f''.
	+ \<lbrakk> f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X; x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' \<rbrakk> \<Longrightarrow>
	+ f'' = f'"
	+ by auto
	+ have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_intro: cat_ss_cs_intros)+
	+ show ?thesis
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X" by (rule f')
	+ have "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
	+ proof-
	+ from x'_def have
	+ "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by simp
	+ from this that f' show "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed
	+ from this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S] show
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+ by auto
	+ fix f'' assume prems':
	+ "f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X"
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
	+ have "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
	+ proof(rule ntcf_eqI)
	+ show "x' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (rule x'.is_ntcf_axioms)
	+ from prems'(1) show
	+ "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' :
	+ cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
	+ \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ have dom_lhs: "\<D>\<^sub>\<circ> (x'\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from prems'(1) have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "x'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems'': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
	+ from this prems'(1) show
	+ "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by (elim the_cat_scospan_ObjE; simp only:)
	+ (
	+ cs_concl
	+ cs_simp:
	+ prems'(2,3)
	+ cat_cone_cospan(1,2)[OF assms cf_scospan_axioms]
	+ cat_pb_cone_cospan
	+ cat_ss_cs_simps cat_cs_simps
	+ cs_intro: cat_ss_cs_intros cat_cs_intros
	+ )+
	+ qed (auto simp: cat_cs_intros)
	+ qed simp_all
	+ from unique_f'[OF prems'(1) this] show "f'' = f'".
	+ qed
	+qed
	+
	+lemma (in is_cat_pullback) cat_pb_unique:
	+ assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
	+ by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])
	+
	+lemma (in is_cat_pullback) cat_pb_unique':
	+ assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
	+proof-
	+ interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
	+ show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
	+qed
	+
	+lemma (in is_cat_pushout) cat_po_unique_cocone:
	+ assumes "x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+proof-
	+ interpret x': is_cat_cocone \<alpha> X' \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x'
	+ by (rule assms(1))
	+ have [cat_op_simps]:
	+ "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ for f'
	+ by (intro iffI conjI; (elim conjE)?)
	+ (
	+ cs_concl
	+ cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
	+ cs_intro: cat_cs_intros cat_ss_cs_intros
	+ )+
	+ show ?thesis
	+ by
	+ (
	+ rule is_cat_pullback.cat_pb_unique_cone[
	+ OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps],
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+lemma (in is_cat_pushout) cat_po_unique:
	+ assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'. f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and> x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
	+ by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])
	+
	+lemma (in is_cat_pushout) cat_po_unique':
	+ assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "\<exists>!f'.
	+ f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
	+ x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+proof-
	+ interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
	+ show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
	+qed
	+
	+lemma cat_pullback_ex_is_iso_arr:
	+ assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	+ and "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f"
	+proof-
	+ interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	+ interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr[
	+ OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_pullback_ex_is_iso_arr':
	+ assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	+ and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+proof-
	+ interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	+ interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	+ obtain f where f: "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
	+ and "j \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
	+ by
	+ (
	+ elim cat_lim_ex_is_iso_arr'[
	+ OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
	+ ]
	+ )
	+ then have
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
	+ by (auto simp: cat_ss_cs_intros)
	+ with f show ?thesis using that by simp
	+qed
	+
	+lemma cat_pushout_ex_is_iso_arr:
	+ assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	+ and "x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
	+proof-
	+ interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	+ interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	+ from that show ?thesis
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr[
	+ OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
	+ ]
	+ )
	+qed
	+
	+lemma cat_pushout_ex_is_iso_arr':
	+ assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	+ obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	+ and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	+ and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+proof-
	+ interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
	+ interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
	+ obtain f where f: "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
	+ and "j \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
	+ by
	+ (
	+ elim cat_colim_ex_is_iso_arr'[
	+ OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
	+ ]
	+ )
	+ then have "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
	+ and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
	+ by (auto simp: cat_ss_cs_intros)
	+ with f show ?thesis using that by simp
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
	@@ -1,3656 +1,3478 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Pointwise Kan extensions\<close>
	theory CZH_UCAT_PWKan
	imports CZH_UCAT_Kan
	begin



	subsection\<open>Pointwise Kan extensions\<close>


	text\<open>
	The following subsection is based on elements of the
	content of section 6.3 in \cite{riehl_category_2016} and
	Chapter X-5 in \cite{mac_lane_categories_2010}.
	\<close>

	locale is_cat_pw_rKe = is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>
	for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> +
	assumes cat_pw_rKe_preserved: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
	\<epsilon> :
	\<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
	\<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) : \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"

	syntax "_is_cat_pw_rKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(
	\<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close>
	[51, 51, 51, 51, 51, 51, 51] 51
	)
	translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons>
	"CONST is_cat_pw_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>"

	locale is_cat_pw_lKe = is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>
	for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> +
	assumes cat_pw_lKe_preserved: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
	op_ntcf \<eta> :
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"

	syntax "_is_cat_pw_lKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	(
	\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close>
	[51, 51, 51, 51, 51, 51, 51] 51
	)
	translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons>
	"CONST is_cat_pw_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>"

	lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "\<AA>' = \<AA>"
	and "\<HH>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)"
	and "\<EE>' = cat_Set \<alpha>"
	shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<EE>')"
	using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)

	lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'

	lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]:
	assumes "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
	and "\<FF>' = op_cf \<FF>"
	and "\<KK>' = op_cf \<KK>"
	and "\<TT>' = op_cf \<TT>"
	and "\<BB>' = op_cat \<BB>"
	and "\<CC>' = op_cat \<CC>"
	and "\<AA>' = op_cat \<AA>"
	and "\<HH>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a)"
	and "\<EE>' = cat_Set \<alpha>"
	shows "op_ntcf \<eta> :
	\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<EE>')"
	using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)

	lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'


	text\<open>Rules.\<close>

	lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "\<GG>' = \<GG>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_pw_rKe_axioms)

	mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
	\|intro is_cat_pw_rKeI\|
	\|dest is_cat_pw_rKeD[dest]\|
	\|elim is_cat_pw_rKeE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)

	lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
	assumes "\<alpha>' = \<alpha>"
	and "\<FF>' = \<FF>"
	and "\<KK>' = \<KK>"
	and "\<TT>' = \<TT>"
	and "\<BB>' = \<BB>"
	and "\<AA>' = \<AA>"
	and "\<CC>' = \<CC>"
	shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>'\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_pw_lKe_axioms)

	mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
	\|intro is_cat_pw_lKeI\|
	\|dest is_cat_pw_lKeD[dest]\|
	\|elim is_cat_pw_lKeE[elim]\|

	lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)


	text\<open>Duality.\<close>

	lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
	"op_ntcf \<epsilon> :
	op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
	proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	from cat_pw_rKe_preserved[OF prems] prems show
	"\<epsilon> :
	\<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
	\<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<AA>(-,a) : \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	qed (cs_concl cs_shallow cs_intro: cat_op_intros)

	lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<GG>' = op_cf \<GG>"
	and "\<KK>' = op_cf \<KK>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf \<epsilon> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_pw_lKe_op)

	lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'

	lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
	"op_ntcf \<eta> :
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
	proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show
	"op_ntcf \<eta> :
	op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<AA>(a,-) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
	by (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
	qed (cs_concl cs_shallow cs_intro: cat_op_intros)

	lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
	assumes "\<TT>' = op_cf \<TT>"
	and "\<FF>' = op_cf \<FF>"
	and "\<KK>' = op_cf \<KK>"
	and "\<BB>' = op_cat \<BB>"
	and "\<AA>' = op_cat \<AA>"
	and "\<CC>' = op_cat \<CC>"
	shows "op_ntcf \<eta> : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
	unfolding assms by (rule is_cat_pw_rKe_op)

	lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'



	-(FIXME: any reason not to generalize and include in CZH_UCAT_Hom?)
	-subsection\<open>Cone functor\<close>
	-
	-
	-subsubsection\<open>Definition and elementary properties\<close>
	-
	-definition cf_Cone :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	- where "cf_Cone \<alpha> \<beta> \<FF> =
	- Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F
	- op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
	-
	-
	-text\<open>An alternative form of the definition.\<close>
	-
	-context is_functor
	-begin
	-
	-lemma cf_Cone_def':
	- "cf_Cone \<alpha> \<beta> \<FF> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)"
	- unfolding cf_Cone_def cat_cs_simps by simp
	-
	-end
	-
	-
	-subsubsection\<open>Object map\<close>
	-
	-lemma (in is_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	- shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>)"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms(2) show ?thesis
	- unfolding cf_Cone_def
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_intros] = is_functor.cf_Cone_ObjMap_vsv
	-
	-lemma (in is_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms show ?thesis
	- unfolding cf_Cone_def'
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ObjMap_vdomain
	-
	-lemma (in is_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
	- Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map (cf_const \<AA> \<BB> b)) (cf_map \<FF>)"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms(2,3) show ?thesis
	- unfolding cf_Cone_def
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ObjMap_app
	-
	-
	-subsubsection\<open>Arrow map\<close>
	-
	-lemma (in is_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	- shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>)"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms(2) show ?thesis
	- unfolding cf_Cone_def
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_intros] = is_functor.cf_Cone_ArrMap_vsv
	-
	-lemma (in is_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	- shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms(2) show ?thesis
	- unfolding cf_Cone_def'
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ArrMap_vdomain
	-
	-lemma (in is_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
	- assumes "\<Z> \<beta>"
	- and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	- and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
	- shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
	- (cat_FUNCT \<alpha> \<AA> \<BB>)
	- [ntcf_arrow (ntcf_const \<AA> \<BB> f), cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>]\<^sub>\<circ>"
	-proof-
	- from assms interpret \<beta>: \<Z> \<beta> by simp
	- from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- from assms(2,3) show ?thesis
	- unfolding cf_Cone_def
	- by
	- (
	- cs_concl
	- cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
	- )
	-qed
	-
	-lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ArrMap_app
	-
	-
	-subsubsection\<open>The cone functor is a functor\<close>
	-
	-lemma (in is_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
	- assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	- shows "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	-proof-
	- from assms interpret \<AA>\<BB>: category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close>
	- by
	- (
	- cs_concl cs_intro:
	- cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	- )
	- from assms interpret op_\<Delta>:
	- is_functor \<beta> \<open>op_cat \<BB>\<close> \<open>op_cat (cat_FUNCT \<alpha> \<AA> \<BB>)\<close> \<open>op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)\<close>
	- by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	- have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) :
	- op_cat (cat_FUNCT \<alpha> \<AA> \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	- by
	- (
	- cs_concl cs_shallow
	- cs_simp: cat_FUNCT_cs_simps
	- cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	- )
	- then show "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	- unfolding cf_Cone_def'
	- by (cs_concl cs_intro: cat_cs_intros)
	-qed
	-
	-
	-
	subsection\<open>Lemma X.5: \<open>L_10_5_N\<close>\label{sec:lem_X_5_start}\<close>


	text\<open>
	This subsection and several further subsections
	(\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
	expose definitions that are used in the proof of the technical lemma that
	was used in the proof of Theorem 3 from Chapter X-5
	in \cite{mac_lane_categories_2010}.
	\<close>

	definition L_10_5_N :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
	cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>.
	cf_nt \<alpha> \<beta> \<KK>\<lparr>ArrMap\<rparr>\<lparr>
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>), \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>c\<rparr>
	\<rparr>\<^sub>\<bullet>
	),
	op_cat (\<TT>\<lparr>HomCod\<rparr>),
	cat_Set \<beta>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_N_components:
	shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
	cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet>
	)"
	and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>.
	cf_nt \<alpha> \<beta> \<KK>\<lparr>ArrMap\<rparr>\<lparr>
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>), \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>c\<rparr>
	\<rparr>\<^sub>\<bullet>
	)"
	and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>HomDom\<rparr> = op_cat (\<TT>\<lparr>HomCod\<rparr>)"
	and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas L_10_5_N_components' = L_10_5_N_components[
	where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
	]

	lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)

	end


	subsubsection\<open>Object map\<close>

	mk_VLambda L_10_5_N_components(1)
	\|vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> c
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	mk_VLambda L_10_5_N_components'(1)[OF \<KK> \<TT>]
	\|vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]\|

	end


	subsubsection\<open>Arrow map\<close>

	mk_VLambda L_10_5_N_components(2)
	\|vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> c
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	mk_VLambda L_10_5_N_components'(2)[OF \<KK> \<TT>]
	\|vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]\|
	\|app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]\|

	end


	subsubsection\<open>\<open>L_10_5_N\<close> is a functor\<close>

	lemma L_10_5_N_is_functor:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-

	let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))

	from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+

	from assms(2) interpret cf_nt:
	is_functor \<beta> \<open>?FUNCT \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>cf_nt \<alpha> \<beta> \<KK>\<close>
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	show ?thesis
	proof(intro is_functorI')

	show "vfsequence (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c)" unfolding L_10_5_N_def by simp
	show "vcard (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c) = 4\<^sub>\<nat>"
	unfolding L_10_5_N_def by (simp add: nat_omega_simps)
	show "vsv (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	from assms(3,4) show "vsv (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	from assms show "\<D>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	show "\<R>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	unfolding L_10_5_N_components'[OF \<KK>.is_functor_axioms \<TT>.is_functor_axioms]
	proof(rule vrange_VLambda_vsubset)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	from prems assms show
	"cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ>
	cat_Set \<beta>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
	cs_intro:
	cat_cs_intros FUNCT_\<BB>.cat_Hom_in_Vset cat_FUNCT_cs_intros
	)
	qed

	from assms show "\<D>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)

	show "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
	using that assms
	unfolding cat_op_simps
	by
	(
	cs_concl
	cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app
	cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
	)

	show
	"L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> =
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b' \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c'" and "f : a' \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b'" for b' c' g a' f
	proof-
	from that assms(5) show ?thesis
	unfolding cat_op_simps
	by (slow)
	(
	cs_concl
	cs_intro:
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_FUNCT_cs_simps
	cat_prod_cs_simps
	cat_op_simps
	cf_nt.cf_ArrMap_Comp[symmetric]
	)
	qed

	show
	"L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> =
	cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	proof-
	note [cat_cs_simps] =
	ntcf_id_cf_comp[symmetric]
	ntcf_arrow_id_ntcf_id[symmetric]
	cat_FUNCT_CId_app[symmetric]
	from that[unfolded cat_op_simps] assms show ?thesis
	by (slow)
	(
	cs_concl
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	cs_simp:
	cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
	)
	qed

	qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

	qed

	lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<AA>' = op_cat \<AA>"
	and "\<BB>' = cat_Set \<beta>"
	and "\<beta>' = \<beta>"
	shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
	using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)



	subsection\<open>Lemma X.5: \<open>L_10_5_\<upsilon>_arrow\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<upsilon>_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b =
	[
	(\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>). \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>),
	Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>),
	Hom (\<TT>\<lparr>HomCod\<rparr>) a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<upsilon>_arrow_components:
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrVal\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>). \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>)"
	and "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrDom\<rparr> = Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrCod\<rparr> = Hom (\<TT>\<lparr>HomCod\<rparr>) a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding L_10_5_\<upsilon>_arrow_def arr_field_simps
	by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas L_10_5_\<upsilon>_arrow_components' = L_10_5_\<upsilon>_arrow_components[
	where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
	]

	lemmas [cat_Kan_cs_simps] = L_10_5_\<upsilon>_arrow_components'(2,3)

	end


	subsubsection\<open>Arrow value\<close>

	mk_VLambda L_10_5_\<upsilon>_arrow_components(1)
	\|vsv L_10_5_\<upsilon>_arrow_ArrVal_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	mk_VLambda L_10_5_\<upsilon>_arrow_components'(1)[OF \<KK> \<TT>]
	\|vdomain L_10_5_\<upsilon>_arrow_ArrVal_vdomain[cat_Kan_cs_simps]\|
	\|app L_10_5_\<upsilon>_arrow_ArrVal_app[unfolded in_Hom_iff]\|

	end

	lemma L_10_5_\<upsilon>_arrow_ArrVal_app':
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	from assms(3) have c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	show ?thesis by (rule L_10_5_\<upsilon>_arrow_ArrVal_app[OF assms(1,2,3)])
	qed


	subsubsection\<open>\<open>L_10_5_\<upsilon>_arrow\<close> is an arrow\<close>

	lemma L_10_5_\<upsilon>_arrow_ArrVal_is_arr:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(4))
	from assms(5,6) show ?thesis
	unfolding assms(3)
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	L_10_5_\<upsilon>_arrow_ArrVal_app
	cat_comma_cs_simps
	cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed

	lemma L_10_5_\<upsilon>_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "a' = a"
	and "b' = \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "\<AA>' = \<AA>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"
	using assms(1-3, 7-9)
	unfolding assms(3-6)
	by (rule L_10_5_\<upsilon>_arrow_ArrVal_is_arr)


	-subsubsection\<open>Further elementary properties\<close>
	+subsubsection\<open>Further properties\<close>

	lemma L_10_5_\<upsilon>_arrow_is_arr:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b :
	Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	proof-
	note L_10_5_\<upsilon>_arrow_components = L_10_5_\<upsilon>_arrow_components'[OF assms(1,2)]
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(5))
	show ?thesis
	proof(intro cat_Set_is_arrI)
	show "arr_Set \<alpha> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b)"
	proof(intro arr_SetI)
	show "vfsequence (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b)"
	unfolding L_10_5_\<upsilon>_arrow_def by simp
	show "vcard (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b) = 3\<^sub>\<nat>"
	unfolding L_10_5_\<upsilon>_arrow_def by (simp add: nat_omega_simps)
	show
	"\<R>\<^sub>\<circ> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrCod\<rparr>"
	unfolding L_10_5_\<upsilon>_arrow_components
	proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
	fix f assume "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	from L_10_5_\<upsilon>_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this
	show "\<tau>'\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> : a \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: L_10_5_\<upsilon>_arrow_ArrVal_app' cat_cs_simps
	cs_intro: cat_cs_intros
	)
	qed
	from assms(3,6) show "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
	from assms(1-3,6) \<tau>.cat_cone_obj show
	"L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
	qed (auto simp: L_10_5_\<upsilon>_arrow_components)
	qed (simp_all add: L_10_5_\<upsilon>_arrow_components)
	qed

	lemma L_10_5_\<upsilon>_arrow_is_arr'[cat_Kan_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "A = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "B = Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	and "\<CC>' = cat_Set \<alpha>"
	shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b : A \<mapsto>\<^bsub>\<CC>'\<^esub> B"
	using assms(1-6) unfolding assms(7-9) by (rule L_10_5_\<upsilon>_arrow_is_arr)

	lemma L_10_5_\<upsilon>_cf_hom[cat_Kan_cs_simps]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
	shows
	"L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>, \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> =
	cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a a'"
	(is "?lhs = ?rhs")
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(5))

	have [cat_Kan_cs_simps]:
	"\<tau>\<lparr>NTMap\<rparr>\<lparr>a'', b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> =
	\<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>"
	if F_def: "F = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [a', b', f']\<^sub>\<circ>"
	and B_def: "B = [a'', b'', f'']\<^sub>\<circ>"
	and F: "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
	for F A B a' b' f' a'' b'' f'' g' h'
	proof-
	from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
	and a''_def: "a'' = 0"
	and g'_def: "g' = 0"
	and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	and f'': "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
	and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
	by auto
	+ note \<tau>.cat_cone_Comp_commute[cat_cs_simps del]
	from
	\<tau>.ntcf_Comp_commute[OF F]
	that(2) F g' h' f' f''
	\<KK>.is_functor_axioms
	\<TT>.is_functor_axioms
	show
	"\<tau>\<lparr>NTMap\<rparr>\<lparr>a'', b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> =
	\<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>"
	unfolding F_def A_def B_def a'_def a''_def g'_def
	by (slow)
	(
	cs_prems
	cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed

	from assms(3) assms(6,7) \<KK>.HomCod.category_axioms have lhs_is_arr:
	"?lhs : Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
	unfolding assms(4)
	by
	(
	cs_concl cs_intro:
	cat_lim_cs_intros
	cat_cs_intros
	cat_Kan_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	then have dom_lhs: "\<D>\<^sub>\<circ> ((?lhs)\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms(3) assms(6,7) \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms
	have rhs_is_arr:
	"?rhs : Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
	unfolding assms(4)
	by
	(
	cs_concl cs_intro:
	cat_lim_cs_intros
	cat_cs_intros
	cat_Kan_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	then have dom_rhs: "\<D>\<^sub>\<circ> ((?rhs)\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs_is_arr show arr_Set_lhs: "arr_Set \<alpha> ?lhs"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs_is_arr show arr_Set_rhs: "arr_Set \<alpha> ?rhs"
	by (auto dest: cat_Set_is_arrD(1))
	show "?lhs\<lparr>ArrVal\<rparr> = ?rhs\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix g assume prems: "g : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	from prems assms(7) have \<KK>f:
	"\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	with assms(6,7) prems \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms
	show "?lhs\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?rhs\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	by (slow)
	(
	cs_concl
	cs_intro:
	cat_lim_cs_intros
	cat_cs_intros
	cat_Kan_cs_intros
	cat_comma_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	cat_1_is_arrI
	cs_simp:
	L_10_5_\<upsilon>_arrow_ArrVal_app'
	cat_cs_simps
	cat_Kan_cs_simps
	cat_op_simps
	cat_FUNCT_cs_simps
	cat_comma_cs_simps
	assms(4)
	)+
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed
	(
	use lhs_is_arr rhs_is_arr in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
	)+
	qed



	subsection\<open>Lemma X.5: \<open>L_10_5_\<tau>\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<tau> where "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a =
	[
	(\<lambda>bf\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<upsilon>\<lparr>NTMap\<rparr>\<lparr>bf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>bf\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>),
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) a,
	\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
	c \<down>\<^sub>C\<^sub>F \<KK>,
	(\<TT>\<lparr>HomCod\<rparr>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<tau>_components:
	shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTMap\<rparr> =
	(\<lambda>bf\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<upsilon>\<lparr>NTMap\<rparr>\<lparr>bf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>bf\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>)"
	and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDom\<rparr> = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) a"
	and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDGDom\<rparr> = c \<down>\<^sub>C\<^sub>F \<KK>"
	and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDGCod\<rparr> = (\<TT>\<lparr>HomCod\<rparr>)"
	unfolding L_10_5_\<tau>_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas L_10_5_\<tau>_components' = L_10_5_\<tau>_components[
	where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
	]

	lemmas [cat_Kan_cs_simps] = L_10_5_\<tau>_components'(2-5)

	end


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda L_10_5_\<tau>_components(1)
	\|vsv L_10_5_\<tau>_NTMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain L_10_5_\<tau>_NTMap_vdomain[cat_Kan_cs_simps]\|

	lemma L_10_5_\<tau>_NTMap_app[cat_Kan_cs_simps]:
	assumes "bf = [0, b, f]\<^sub>\<circ>" and "bf \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> = \<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	using assms unfolding L_10_5_\<tau>_components by (simp add: nat_omega_simps)


	subsubsection\<open>\<open>L_10_5_\<tau>\<close> is a cone\<close>

	lemma L_10_5_\<tau>_is_cat_cone[cat_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<upsilon>'_def: "\<upsilon>' = ntcf_arrow \<upsilon>"
	and \<upsilon>: "\<upsilon> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
	let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	from assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from assms(3) interpret \<Pi>c: is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	interpret \<upsilon>: is_ntcf \<alpha> \<BB> \<open>cat_Set \<alpha>\<close> \<open>?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<open>?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>\<close> \<upsilon>
	by (rule \<upsilon>)

	show ?thesis
	proof(intro is_cat_coneI is_ntcfI')
	show "vfsequence (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a)" unfolding L_10_5_\<tau>_def by simp
	show "vcard (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a) = 5\<^sub>\<nat>"
	unfolding L_10_5_\<tau>_def by (simp add: nat_omega_simps)
	from a interpret cf_const:
	is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<close>
	by (cs_concl cs_intro: cat_cs_intros)
	show "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr>"
	if "bf \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for bf
	proof-
	from that assms(3) obtain b f
	where bf_def: "bf = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from \<upsilon>.ntcf_NTMap_is_arr[OF b] a b assms(3) f have "\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	with that b f show "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr>"
	unfolding bf_def \<upsilon>'_def
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_comma_cs_simps
	cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed

	show
	"L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	(\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	if "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
	proof-
	from \<KK>.is_functor_axioms that assms(3) obtain a' f a'' f' g
	where F_def: "F = [[0, a', f]\<^sub>\<circ>, [0, a'', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
	and A_def: "A = [0, a', f]\<^sub>\<circ>"
	and B_def: "B = [0, a'', f']\<^sub>\<circ>"
	and g: "g : a' \<mapsto>\<^bsub>\<BB>\<^esub> a''"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
	and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr>"
	and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
	by auto
	from \<upsilon>.ntcf_Comp_commute[OF g] have
	"(\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a''\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	((?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by simp
	from this a g f f' \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms
	have [cat_cs_simps]:
	"\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a''\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> =
	\<TT>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by (slow)
	(
	cs_prems
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	from that a g f f' \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms
	show ?thesis
	unfolding F_def A_def B_def \<upsilon>'_def (slow)
	by
	(
	cs_concl
	cs_simp:
	f'_def[symmetric]
	cat_cs_simps
	cat_Kan_cs_simps
	cat_comma_cs_simps
	cat_FUNCT_cs_simps
	cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	qed

	qed
	(
	use assms in
	\<open>
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros a
	\<close>
	)+

	qed

	lemma L_10_5_\<tau>_is_cat_cone'[cat_Kan_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<upsilon>' = ntcf_arrow \<upsilon>"
	and "\<FF>' = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	and "c\<KK> = c \<down>\<^sub>C\<^sub>F \<KK>"
	and "\<AA>' = \<AA>"
	and "\<alpha>' = \<alpha>"
	and "\<upsilon> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	\<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : c\<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<AA>'"
	using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_\<tau>_is_cat_cone)



	subsection\<open>Lemma X.5: \<open>L_10_5_\<upsilon>\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<upsilon> :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a =
	[
	(\<lambda>b\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>,
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>,
	\<TT>\<lparr>HomDom\<rparr>,
	cat_Set \<alpha>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<upsilon>_components:
	shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTMap\<rparr> =
	(\<lambda>b\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b)"
	and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
	and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
	and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDGDom\<rparr> = \<TT>\<lparr>HomDom\<rparr>"
	and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding L_10_5_\<upsilon>_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas L_10_5_\<upsilon>_components' = L_10_5_\<upsilon>_components[
	where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
	]

	lemmas [cat_Kan_cs_simps] = L_10_5_\<upsilon>_components'(2-5)

	end


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda L_10_5_\<upsilon>_components(1)
	\|vsv L_10_5_\<upsilon>_NTMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
	assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
	interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	mk_VLambda L_10_5_\<upsilon>_components'(1)[OF \<KK> \<TT>]
	\|vdomain L_10_5_\<upsilon>_NTMap_vdomain[cat_Kan_cs_simps]\|
	\|app L_10_5_\<upsilon>_NTMap_app[cat_Kan_cs_simps]\|

	end


	subsubsection\<open>\<open>L_10_5_\<upsilon>\<close> is a natural transformation\<close>

	lemma L_10_5_\<upsilon>_is_ntcf:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<tau>'_def: "\<tau>' = ntcf_arrow \<tau>"
	and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	(is \<open>?L_10_5_\<upsilon> : ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>\<close>)
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>
	by (rule assms(5))

	from assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from assms(3) interpret \<Pi>c: is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)

	show "?L_10_5_\<upsilon> : ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof(intro is_ntcfI')
	show "vfsequence ?L_10_5_\<upsilon>" unfolding L_10_5_\<upsilon>_def by auto
	show "vcard ?L_10_5_\<upsilon> = 5\<^sub>\<nat>"
	unfolding L_10_5_\<upsilon>_def by (simp add: nat_omega_simps)
	show "?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	(?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
	proof-
	from a that assms(3) show ?thesis
	unfolding \<tau>'_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro:
	cat_Kan_cs_intros
	cat_lim_cs_intros
	cat_cs_intros
	cat_op_intros
	)
	qed
	show
	"?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
	if "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'" for a' b' f
	proof-
	from that a assms(3) show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps \<tau>'_def
	cs_intro: cat_lim_cs_intros cat_cs_intros
	)
	qed

	qed
	(
	use assms(3,6) in
	\<open>
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	\<close>
	)+

	qed

	lemma L_10_5_\<upsilon>_is_ntcf'[cat_Kan_cs_intros]:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "\<tau>' = ntcf_arrow \<tau>"
	and "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
	and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
	and "\<BB>' = \<BB>"
	and "\<CC>' = cat_Set \<alpha>"
	and "\<alpha>' = \<alpha>"
	and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
	using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_\<upsilon>_is_ntcf)



	subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>_arrow\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<chi>_arrow
	where "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a =
	[
	(\<lambda>\<upsilon>\<in>\<^sub>\<circ>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>. ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a)),
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<chi>_arrow_components:
	shows "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr> =
	(\<lambda>\<upsilon>\<in>\<^sub>\<circ>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>. ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a))"
	and "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrDom\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrCod\<rparr> =
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	unfolding L_10_5_\<chi>_arrow_def arr_field_simps
	by (simp_all add: nat_omega_simps)

	lemmas [cat_Kan_cs_simps] = L_10_5_\<chi>_arrow_components(2,3)


	subsubsection\<open>Arrow value\<close>

	mk_VLambda L_10_5_\<chi>_arrow_components(1)
	\|vsv L_10_5_\<chi>_arrow_vsv[cat_Kan_cs_intros]\|
	\|vdomain L_10_5_\<chi>_arrow_vdomain\|
	\|app L_10_5_\<chi>_arrow_app\|

	lemma L_10_5_\<chi>_arrow_vdomain'[cat_Kan_cs_simps]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>) = Hom
	(cat_FUNCT \<alpha> \<BB> (cat_Set \<alpha>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>))
	(cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>))"
	using assms
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_\<chi>_arrow_vdomain
	cs_intro: cat_cs_intros
	)

	lemma L_10_5_\<chi>_arrow_app'[cat_Kan_cs_simps]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<upsilon>'_def: "\<upsilon>' = ntcf_arrow \<upsilon>"
	and \<upsilon>: "\<upsilon> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows
	"L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<upsilon>'\<rparr> =
	ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a)"
	using assms
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_\<chi>_arrow_app
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	lemma \<upsilon>\<tau>a_def:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and \<upsilon>\<tau>a'_def: "\<upsilon>\<tau>a' = ntcf_arrow \<upsilon>\<tau>a"
	and \<upsilon>\<tau>a: "\<upsilon>\<tau>a :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	\<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<upsilon>\<tau>a = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c (ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a' a)) a"
	(is \<open>\<upsilon>\<tau>a = ?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a\<close>)
	proof-

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	interpret \<upsilon>\<tau>a: is_ntcf
	\<alpha> \<BB> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>\<close> \<upsilon>\<tau>a
	by (rule \<upsilon>\<tau>a)

	show ?thesis
	proof(rule ntcf_eqI)
	show "\<upsilon>\<tau>a :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule \<upsilon>\<tau>a)
	from assms(1-3) a show
	"?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps \<upsilon>\<tau>a'_def
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)
	have dom_lhs: "\<D>\<^sub>\<circ> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have dom_rhs: "\<D>\<^sub>\<circ> (?L_10_5_\<upsilon> (ntcf_arrow (?L_10_5_\<tau>)) a\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
	show "\<upsilon>\<tau>a\<lparr>NTMap\<rparr> = ?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	from prems assms(3) a have lhs: "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
	Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from prems assms(3) a have rhs:
	"L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b :
	Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	unfolding \<upsilon>\<tau>a'_def
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)

	then have dom_rhs:
	"\<D>\<^sub>\<circ> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>) =
	Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	have [cat_cs_simps]:
	"\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b"
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs: "arr_Set \<alpha> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs:
	"arr_Set \<alpha> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow (?L_10_5_\<tau>)) a b)"
	by (auto dest: cat_Set_is_arrD(1))
	show "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr> =
	L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix f assume "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	with assms prems show
	"\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	unfolding \<upsilon>\<tau>a'_def
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_\<upsilon>_arrow_ArrVal_app
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)
	qed (use lhs rhs in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	from prems show
	"\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	)

	qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+

	qed simp_all

	qed



	subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>'_arrow\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<chi>'_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a =
	[
	(
	\<lambda>\<tau>\<in>\<^sub>\<circ>cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>.
	ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a)
	),
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<chi>'_arrow_components:
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr> =
	(
	\<lambda>\<tau>\<in>\<^sub>\<circ>cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>.
	ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a)
	)"
	and [cat_Kan_cs_simps]: "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrDom\<rparr> =
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and [cat_Kan_cs_simps]: "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrCod\<rparr> =
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	unfolding L_10_5_\<chi>'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Arrow value\<close>

	mk_VLambda L_10_5_\<chi>'_arrow_components(1)
	\|vsv L_10_5_\<chi>'_arrow_ArrVal_vsv[cat_Kan_cs_intros]\|
	\|vdomain L_10_5_\<chi>'_arrow_ArrVal_vdomain\|
	\|app L_10_5_\<chi>'_arrow_ArrVal_app\|

	lemma L_10_5_\<chi>'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "\<D>\<^sub>\<circ> (L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>) = Hom
	(cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>)
	(cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a))
	(cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>
	by (rule assms(3))
	from assms(1,2,4) show ?thesis
	by
	(
	cs_concl cs_shallow
	- cs_simp: cat_Kan_cs_simps L_10_5_\<chi>'_arrow_ArrVal_vdomain
	+ cs_simp: cat_cs_simps L_10_5_\<chi>'_arrow_ArrVal_vdomain
	cs_intro: cat_cs_intros
	)
	qed

	lemma L_10_5_\<chi>'_arrow_ArrVal_app'[cat_cs_simps]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and \<tau>'_def: "\<tau>' = ntcf_arrow \<tau>"
	and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> =
	ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a)"
	proof-
	interpret \<beta>: \<Z> \<beta> by (rule assms(1))
	interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>
	by (rule assms(4))
	from assms(2,5) have "\<tau>' \<in>\<^sub>\<circ> cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	unfolding \<tau>'_def
	by
	(
	cs_concl
	- cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
	+ cs_simp: cat_cs_simps
	cs_intro: cat_FUNCT_cs_intros cat_cs_intros
	)
	then show
	"L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> =
	ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a)"
	unfolding L_10_5_\<chi>'_arrow_components by auto
	qed


	subsubsection\<open>\<open>L_10_5_\<chi>'_arrow\<close> is an isomorphism in the category \<open>Set\<close>\<close>

	-lemma L_10_5_\<chi>'_arrow_is_arr_isomorphism:
	+lemma L_10_5_\<chi>'_arrow_is_iso_arr:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a :
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub>
	- L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" (FIXME: any reason not to evaluate ObjMap)
	+ L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" (FIXME: any reason not to evaluate ObjMap?)
	(
	is
	\<open>
	?L_10_5_\<chi>'_arrow :
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub>
	?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
	\<close>
	)
	proof-

	let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
	let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
	let ?H_\<AA> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>

	from assms(1,2) interpret \<beta>: \<Z> \<beta> by simp

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))

	from \<KK>.vempty_is_zet assms interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from assms(2,6) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<KK>.vempty_is_zet assms interpret \<Pi>c:
	is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

	from assms(2) interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2) interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	have \<TT>\<Pi>: "\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros)

	from assms(5,6) have [cat_cs_simps]:
	"cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) =
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a"
	"cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)) = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	"cf_of_cf_map \<BB> (cat_Set \<alpha>) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>)) =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
	"cf_of_cf_map \<BB> (cat_Set \<alpha>) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)) =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+

	note cf_Cone_ObjMap_app = is_functor.cf_Cone_ObjMap_app[OF \<TT>\<Pi> assms(1,2,6)]

	show ?thesis
	proof
	(
	- intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
	+ intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI,
	unfold L_10_5_\<chi>'_arrow_components(3) cf_Cone_ObjMap_app
	)
	show "vfsequence ?L_10_5_\<chi>'_arrow"
	unfolding L_10_5_\<chi>'_arrow_def by auto
	show \<chi>'_arrow_ArrVal_vsv: "vsv (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
	unfolding L_10_5_\<chi>'_arrow_components by auto
	show "vcard ?L_10_5_\<chi>'_arrow = 3\<^sub>\<nat>"
	unfolding L_10_5_\<chi>'_arrow_def by (simp add: nat_omega_simps)
	show [cat_cs_simps]:
	"\<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) = ?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr>"
	unfolding L_10_5_\<chi>'_arrow_components by simp
	show vrange_\<chi>'_arrow_vsubset_N'':
	"\<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	unfolding L_10_5_\<chi>'_arrow_components
	proof(rule vrange_VLambda_vsubset)
	fix \<tau> assume prems: "\<tau> \<in>\<^sub>\<circ> cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	from this assms c\<KK>_\<AA>.category_axioms have \<tau>_is_arr:
	"\<tau> : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_components(1)
	cs_intro: cat_cs_intros
	)
	note \<tau> = cat_FUNCT_is_arrD(1,2)[OF \<tau>_is_arr, unfolded cat_cs_simps]
	have "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)) = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
	from prems assms \<tau>(1) show
	"ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a) \<in>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (subst \<tau>(2)) (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro:
	is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
	)
	qed

	show "\<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) = ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	proof
	(
	intro vsubset_antisym[OF vrange_\<chi>'_arrow_vsubset_N''],
	intro vsubsetI
	)

	fix \<upsilon>\<tau>a assume "\<upsilon>\<tau>a \<in>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	from this assms have \<upsilon>\<tau>a:
	"\<upsilon>\<tau>a : cf_map (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>) \<mapsto>\<^bsub>?FUNCT \<BB>\<^esub> cf_map (?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	)
	note \<upsilon>\<tau>a = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
	interpret \<tau>:
	is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a\<close>
	by (rule L_10_5_\<tau>_is_cat_cone[OF assms(3,4,5) \<upsilon>\<tau>a(2,1) assms(6)])

	show "\<upsilon>\<tau>a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
	proof(rule vsv.vsv_vimageI2')
	show "vsv (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)" by (rule \<chi>'_arrow_ArrVal_vsv)
	from \<tau>.is_cat_cone_axioms assms show
	"ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a) \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from assms \<upsilon>\<tau>a(1,2) show
	"\<upsilon>\<tau>a = ?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a)\<rparr>"
	by
	(
	subst \<upsilon>\<tau>a(2),
	cs_concl_step \<upsilon>\<tau>a_def[OF assms(3,4,5) \<upsilon>\<tau>a(2,1) assms(6)]
	)
	(cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed
	qed

	from assms show "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_FUNCT_components(1) cf_Cone_ObjMap_app
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros c\<KK>_\<AA>.cat_Hom_in_Vset
	)
	with assms(2) have "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by (meson Vset_in_mono Vset_trans)
	from assms show "?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros FUNCT_\<BB>.cat_Hom_in_Vset cat_FUNCT_cs_intros
	)
	show dom_\<chi>'_arrow: "\<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) =
	Hom ?c\<KK>_\<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
	unfolding L_10_5_\<chi>'_arrow_components cf_Cone_ObjMap_app by simp
	show "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> =
	Hom ?c\<KK>_\<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
	unfolding L_10_5_\<chi>'_arrow_components cf_Cone_ObjMap_app by simp
	show "v11 (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
	proof(rule vsv.vsv_valeq_v11I, unfold dom_\<chi>'_arrow in_Hom_iff)
	fix \<tau>' \<tau>'' assume prems:
	"\<tau>' : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
	"\<tau>'' : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
	"?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> = ?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>\<tau>''\<rparr>"
	note \<tau>' = cat_FUNCT_is_arrD[OF prems(1), unfolded cat_cs_simps]
	and \<tau>'' = cat_FUNCT_is_arrD[OF prems(2), unfolded cat_cs_simps]
	interpret \<tau>': is_cat_cone
	\<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<close>
	by (rule is_cat_coneI[OF \<tau>'(1) assms(6)])
	interpret \<tau>'': is_cat_cone
	\<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<close>
	by (rule is_cat_coneI[OF \<tau>''(1) assms(6)])
	have \<tau>'\<tau>': "ntcf_arrow (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>') = \<tau>'"
	by (subst (2) \<tau>'(2)) (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	have \<tau>''\<tau>'': "ntcf_arrow (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'') = \<tau>''"
	by (subst (2) \<tau>''(2)) (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)
	from prems(3) \<tau>'(1) \<tau>''(1) assms have
	"L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>'' a"
	by (subst (asm) \<tau>'(2), use nothing in \<open>subst (asm) \<tau>''(2)\<close>) (slow)
	(
	cs_prems cs_shallow
	cs_simp: \<tau>'\<tau>' \<tau>''\<tau>'' cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
	)
	from this have \<upsilon>\<tau>'a_\<upsilon>\<tau>''a:
	"L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
	L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>'' a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" for b f
	by simp
	have [cat_cs_simps]: "\<tau>'\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> = \<tau>''\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>"
	if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" for b f
	using \<upsilon>\<tau>'a_\<upsilon>\<tau>''a[OF that] that
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_Kan_cs_simps L_10_5_\<upsilon>_arrow_ArrVal_app
	cs_intro: cat_cs_intros
	)
	have
	"ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>' =
	ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''"
	proof(rule ntcf_eqI)
	show "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>' :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a \<mapsto>\<^sub>C\<^sub>F \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule \<tau>'.is_ntcf_axioms)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'' :
	cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a \<mapsto>\<^sub>C\<^sub>F \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule \<tau>''.is_ntcf_axioms)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show
	"ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr> =
	ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix A assume "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
	with assms(5) obtain b f
	where A_def: "A = [0, b, f]\<^sub>\<circ>"
	and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by auto
	from b f show
	"ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
	ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	unfolding A_def
	- by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
	+ by (cs_concl cs_simp: cat_cs_simps cat_map_extra_cs_simps)
	qed (cs_concl cs_shallow cs_intro: V_cs_intros)+
	qed simp_all
	then show "\<tau>' = \<tau>''"
	proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
	show "\<tau>' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>"
	by (subst \<tau>'(2))
	(
	cs_concl cs_intro:
	cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	show "\<tau>'' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>"
	by (subst \<tau>''(2))
	(
	cs_concl cs_intro:
	cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	qed
	qed (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)

	qed auto

	qed

	-lemma L_10_5_\<chi>'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]:
	+lemma L_10_5_\<chi>'_arrow_is_iso_arr'[cat_Kan_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "A = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<CC>' = cat_Set \<beta>"
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B"
	using assms(1-6)
	unfolding assms(7-9)
	- by (rule L_10_5_\<chi>'_arrow_is_arr_isomorphism)
	+ by (rule L_10_5_\<chi>'_arrow_is_iso_arr)

	lemma L_10_5_\<chi>'_arrow_is_arr:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a :
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	- rule cat_Set_is_arr_isomorphismD(1)[
	- OF L_10_5_\<chi>'_arrow_is_arr_isomorphism[OF assms(1-6)]
	+ rule cat_Set_is_iso_arrD(1)[
	+ OF L_10_5_\<chi>'_arrow_is_iso_arr[OF assms(1-6)]
	]
	)

	lemma L_10_5_\<chi>'_arrow_is_arr'[cat_Kan_cs_intros]:
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "A = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "B = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	and "\<CC>' = cat_Set \<beta>"
	shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a : A \<mapsto>\<^bsub>\<CC>'\<^esub> B"
	using assms(1-6) unfolding assms(7-9) by (rule L_10_5_\<chi>'_arrow_is_arr)



	subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>\<close>\label{sec:lem_X_5_end}\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition L_10_5_\<chi> :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a),
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>),
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c,
	op_cat (\<TT>\<lparr>HomCod\<rparr>),
	cat_Set \<beta>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma L_10_5_\<chi>_components:
	shows "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTMap\<rparr> =
	(\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a)"
	and [cat_Kan_cs_simps]:
	"L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDom\<rparr> = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
	and [cat_Kan_cs_simps]:
	"L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c"
	and "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDGDom\<rparr> = op_cat (\<TT>\<lparr>HomCod\<rparr>)"
	and [cat_Kan_cs_simps]: "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
	unfolding L_10_5_\<chi>_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<BB> \<TT>
	assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	lemmas L_10_5_\<chi>_components' =
	L_10_5_\<chi>_components[where \<TT>=\<TT>, unfolded cat_cs_simps]

	lemmas [cat_Kan_cs_simps] = L_10_5_\<chi>_components'(4)

	end


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda L_10_5_\<chi>_components(1)
	\|vsv L_10_5_\<chi>_NTMap_vsv[cat_Kan_cs_intros]\|

	context
	fixes \<alpha> \<AA> \<BB> \<TT>
	assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)

	mk_VLambda L_10_5_\<chi>_components(1)[where \<TT>=\<TT>, unfolded cat_cs_simps]
	\|vdomain L_10_5_\<chi>_NTMap_vdomain[cat_Kan_cs_simps]\|
	\|app L_10_5_\<chi>_NTMap_app[cat_Kan_cs_simps]\|

	end


	subsubsection\<open>\<open>L_10_5_\<chi>\<close> is a natural isomorphism\<close>

	lemma L_10_5_\<chi>_is_iso_ntcf:
	\<comment>\<open>See lemma on page 245 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<Z> \<beta>"
	and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c :
	cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o L_10_5_N \<alpha> \<beta> \<TT> \<KK> c :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	(is \<open>?L_10_5_\<chi> : ?cf_Cone \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o ?L_10_5_N : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>\<close>)
	proof-

	let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
	let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?ntcf_c\<KK>_\<AA> = \<open>ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?\<TT>_c\<KK> = \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
	let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
	let ?L_10_5_\<chi>'_arrow = \<open>L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c\<close>
	let ?cf_c\<KK>_\<AA> = \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?L_10_5_\<upsilon> = \<open>L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c\<close>
	let ?L_10_5_\<upsilon>_arrow = \<open>L_10_5_\<upsilon>_arrow \<TT> \<KK> c\<close>

	interpret \<beta>: \<Z> \<beta> by (rule assms(1))

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))

	from \<KK>.vempty_is_zet assms(5) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from assms(1,2,5) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	interpret \<beta>_c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros assms(2))+
	from assms(2,5) interpret \<Delta>: is_functor \<beta> \<AA> ?c\<KK>_\<AA> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
	from \<KK>.vempty_is_zet assms(5) interpret \<Pi>c:
	is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	interpret \<beta>\<Pi>c: is_tiny_functor \<beta> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by (rule \<Pi>c.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])

	interpret E: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>cf_eval \<alpha> \<beta> \<CC>\<close>
	by (rule \<KK>.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])

	from assms(2) interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from assms(2) interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
	by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	interpret \<beta>\<AA>: tiny_category \<beta> \<AA>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: tiny_category \<beta> \<BB>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<CC>: tiny_category \<beta> \<CC>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+

	interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+

	interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
	by (rule \<KK>.subcategory_cat_Set_cat_Set[OF assms(1,2)])

	show ?thesis
	proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)

	show "vfsequence (?L_10_5_\<chi>)" unfolding L_10_5_\<chi>_def by auto
	show "vcard (?L_10_5_\<chi>) = 5\<^sub>\<nat>"
	unfolding L_10_5_\<chi>_def by (simp add: nat_omega_simps)
	from assms(2) show "?cf_Cone : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	by (intro is_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
	(cs_concl cs_intro: cat_cs_intros)+

	from assms show "?L_10_5_N : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	show "?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	?cf_Cone\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using assms(2,3,4,5) that
	by
	(
	cs_concl
	cs_simp: L_10_5_\<chi>_NTMap_app
	- cs_intro: cat_cs_intros L_10_5_\<chi>'_arrow_is_arr_isomorphism
	+ cs_intro: cat_cs_intros L_10_5_\<chi>'_arrow_is_iso_arr
	)
	- from cat_Set_is_arr_isomorphismD[OF this] show
	+ from cat_Set_is_iso_arrD[OF this] show
	"?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : ?cf_Cone\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that by auto

	have [cat_cs_simps]:
	"?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
	cf_hom ?c\<KK>_\<AA> [ntcf_arrow (?ntcf_c\<KK>_\<AA> f), ntcf_arrow (ntcf_id ?\<TT>_c\<KK>)]\<^sub>\<circ> =
	cf_hom (?FUNCT \<BB>)
	[
	ntcf_arrow (ntcf_id (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)),
	ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>)
	]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a"
	(
	is
	"?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs =
	?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a"
	)
	if "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" for a b f
	proof-
	let ?H_f = \<open>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-)\<close>
	from that assms c\<KK>_\<AA>.category_axioms c\<KK>_\<AA>.category_axioms have lhs:
	"?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs :
	Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_Kan_cs_simps
	cat_cs_simps
	cat_FUNCT_cs_simps
	cat_FUNCT_components(1)
	cat_op_simps
	cs_intro:
	cat_Kan_cs_intros
	cat_FUNCT_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>) =
	Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from that assms c\<KK>_\<AA>.category_axioms c\<KK>_\<AA>.category_axioms have rhs:
	"?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a :
	Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_Kan_cs_simps
	cat_cs_simps
	cat_FUNCT_components(1)
	cat_op_simps
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>) =
	Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs show arr_Set_lhs:
	"arr_Set \<beta> (?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs show arr_Set_rhs:
	"arr_Set \<beta> (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr> =
	(?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix F assume prems: "F : cf_map (?cf_c\<KK>_\<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map ?\<TT>_c\<KK>"
	let ?F = \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> F\<close>
	from that have [cat_cs_simps]:
	"cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (?cf_c\<KK>_\<AA> a)) = ?cf_c\<KK>_\<AA> a"
	"cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (?\<TT>_c\<KK>)) = ?\<TT>_c\<KK>"
	by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
	note F = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
	from that F(1) have F_const_is_cat_cone:
	"?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: is_cat_coneI cat_cs_intros
	)
	have [cat_cs_simps]:
	"?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b =
	?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a"
	proof(rule ntcf_eqI)
	from assms that F(1) show
	"?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b :
	?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> b \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_intro:
	cat_Kan_cs_intros cat_cs_intros is_cat_coneI
	)
	then have dom_\<upsilon>:
	"\<D>\<^sub>\<circ> (?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr>) =
	\<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms that F(1) show
	"?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a :
	?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> b \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_intro:
	cat_Kan_cs_intros cat_cs_intros is_cat_coneI
	)
	then have dom_f\<TT>\<upsilon>:
	"\<D>\<^sub>\<circ> ((?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>) =
	\<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)
	show
	"?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr> =
	(?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_\<upsilon> dom_f\<TT>\<upsilon>)
	fix b' assume prems': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	let ?Y = \<open>Yoneda_component (?H_\<AA> b) a f (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<close>
	let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
	let ?\<TT>b' = \<open>\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
	have [cat_cs_simps]:
	"?L_10_5_\<upsilon>_arrow (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b b' =
	?Y \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?L_10_5_\<upsilon>_arrow (ntcf_arrow ?F) a b'"
	(is \<open>?\<upsilon>_Ffbb' = ?Y\<upsilon>\<close>)
	proof-
	from assms prems' F_const_is_cat_cone have \<upsilon>_Ffbb':
	"?\<upsilon>_Ffbb' : Hom \<CC> c ?\<KK>b' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b ?\<TT>b'"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros L_10_5_\<upsilon>_arrow_is_arr
	)
	then have dom_\<upsilon>_Ffbb': "\<D>\<^sub>\<circ> (?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr>) = Hom \<CC> c (?\<KK>b')"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms that \<TT>.HomCod.category_axioms prems' F(1) have Y\<upsilon>:
	"?Y\<upsilon> : Hom \<CC> c ?\<KK>b' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b ?\<TT>b'"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
	cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
	)
	then have dom_Y\<upsilon>: "\<D>\<^sub>\<circ> (?Y\<upsilon>\<lparr>ArrVal\<rparr>) = Hom \<CC> c (?\<KK>b')"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	proof(rule arr_Set_eqI)
	from \<upsilon>_Ffbb' show arr_Set_\<upsilon>_Ffbb': "arr_Set \<alpha> ?\<upsilon>_Ffbb'"
	by (auto dest: cat_Set_is_arrD(1))
	from Y\<upsilon> show arr_Set_Y\<upsilon>: "arr_Set \<alpha> ?Y\<upsilon>"
	by (auto dest: cat_Set_is_arrD(1))
	show "?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr> = ?Y\<upsilon>\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_\<upsilon>_Ffbb' dom_Y\<upsilon> in_Hom_iff)
	fix g assume "g : c \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
	with
	assms(2-)
	\<KK>.is_functor_axioms
	\<TT>.is_functor_axioms
	\<TT>.HomCod.category_axioms
	\<KK>.HomCod.category_axioms
	that prems' F(1)
	show "?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?Y\<upsilon>\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp:
	cat_Kan_cs_simps
	cat_cs_simps
	L_10_5_\<upsilon>_arrow_ArrVal_app
	cat_comma_cs_simps
	cat_op_simps
	cs_intro:
	cat_Kan_cs_intros
	is_cat_coneI
	cat_cs_intros
	cat_comma_cs_intros
	cat_op_intros
	cs_simp: cat_FUNCT_cs_simps
	)
	qed (use arr_Set_\<upsilon>_Ffbb' arr_Set_Y\<upsilon> in auto)
	qed
	(
	use \<upsilon>_Ffbb' Y\<upsilon> in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>
	)+
	qed

	from assms prems' that F(1) show
	"?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> =
	(?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_cs_simps
	cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
	)

	- qed (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros cat_cs_intros)+
	+ qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+

	qed simp_all

	from that F(1) interpret F: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>?\<TT>_c\<KK>\<close> ?F
	by (cs_concl cs_shallow cs_intro: is_cat_coneI cat_cs_intros)
	from
	assms(2-) prems F(1) that
	\<TT>.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that] (speedup)
	c\<KK>_\<AA>.category_axioms (speedup)
	show
	"(?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>\<lparr>F\<rparr> =
	(?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>\<lparr>F\<rparr>"
	by (subst (1 2) F(2)) (exceptionally slow)
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_FUNCT_cs_simps
	cat_FUNCT_components(1)
	cat_op_simps
	cs_intro:
	is_cat_coneI
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)
	qed (use arr_Set_lhs arr_Set_rhs in auto)

	qed (use lhs rhs in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed

	show
	"?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_Cone\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	?L_10_5_N\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" for a b f
	using that assms
	by
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_FUNCT_components(1)
	cat_FUNCT_cs_simps
	cat_op_simps
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)

	qed
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed



	subsection\<open>
	The existence of a canonical limit or a canonical colimit for the
	pointwise Kan extensions
	\<close>

	lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
	\<comment>\<open>Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	obtains UA
	where "UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	define \<beta> where "\<beta> = \<alpha> + \<omega>"
	have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
	by (simp_all add: \<beta>_def AG.\<Z>_Limit_\<alpha>\<omega> AG.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def AG.\<Z>_\<alpha>_\<alpha>\<omega>)
	then interpret \<beta>: \<Z> \<beta> by simp

	let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
	let ?H_A = \<open>\<lambda>f. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-)\<close>
	let ?H_A\<GG> = \<open>\<lambda>f. ?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
	let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
	let ?H_\<AA>\<TT> = \<open>\<lambda>a. ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>\<close>
	let ?H_\<AA>\<GG> = \<open>\<lambda>a. ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<GG>\<close>
	let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
	let ?H_\<CC>\<KK> = \<open>\<lambda>c. ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>\<close>
	let ?H_\<AA>\<epsilon> = \<open>\<lambda>b. ?H_\<AA> b \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>\<close>
	let ?SET_\<KK> = \<open>exp_cat_cf \<alpha> (cat_Set \<alpha>) \<KK>\<close>
	let ?H_FUNCT = \<open>\<lambda>\<CC> \<FF>. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>?FUNCT \<CC>(-,cf_map \<FF>)\<close>
	let ?ua_NTDGDom = \<open>op_cat (?FUNCT \<CC>)\<close>
	let ?ua_NTDom = \<open>\<lambda>a. ?H_FUNCT \<CC> (?H_\<AA>\<GG> a)\<close>
	let ?ua_NTCod = \<open>\<lambda>a. ?H_FUNCT \<BB> (?H_\<AA>\<TT> a) \<circ>\<^sub>C\<^sub>F op_cf ?SET_\<KK>\<close>
	let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?ua =
	\<open>
	\<lambda>a. ntcf_ua_fo
	\<beta>
	?SET_\<KK>
	(cf_map (?H_\<AA>\<TT> a))
	(cf_map (?H_\<AA>\<GG> a))
	(ntcf_arrow (?H_\<AA>\<epsilon> a))
	\<close>
	let ?cf_nt = \<open>cf_nt \<alpha> \<beta> (cf_id \<CC>)\<close>
	let ?cf_eval = \<open>cf_eval \<alpha> \<beta> \<CC>\<close>
	let ?\<TT>_c\<KK> = \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	let ?cf_c\<KK>_\<AA> = \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?\<GG>c = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<close>
	let ?\<Delta> = \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
	let ?ntcf_ua_fo =
	\<open>
	\<lambda>a. ntcf_ua_fo
	\<beta>
	?SET_\<KK>
	(cf_map (?H_\<AA>\<TT> a))
	(cf_map (?H_\<AA>\<GG> a))
	(ntcf_arrow (?H_\<AA>\<epsilon> a))
	\<close>
	let ?umap_fo =
	\<open>
	\<lambda>b. umap_fo
	?SET_\<KK>
	(cf_map (?H_\<AA>\<TT> b))
	(cf_map (?H_\<AA>\<GG> b))
	(ntcf_arrow (?H_\<AA>\<epsilon> b))
	(cf_map (?H_\<CC> c))
	\<close>

	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))

	from AG.vempty_is_zet assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
	by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
	from \<alpha>\<beta> assms(3) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
	by
	(
	cs_concl cs_intro:
	cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)
	from \<alpha>\<beta> assms(3) interpret \<Delta>: is_functor \<beta> \<AA> ?c\<KK>_\<AA> ?\<Delta>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)+
	from AG.vempty_is_zet assms(3) interpret \<Pi>c:
	is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)

	interpret \<beta>\<Pi>c: is_tiny_functor \<beta> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
	by (rule \<Pi>c.cf_is_tiny_functor_if_ge_Limit[OF \<beta> \<alpha>\<beta>])

	interpret E: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> ?cf_eval
	by (rule AG.HomCod.cat_cf_eval_is_functor[OF \<beta> \<alpha>\<beta>])

	from \<alpha>\<beta> interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from \<alpha>\<beta> interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
	from \<alpha>\<beta> interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

	interpret \<beta>\<AA>: tiny_category \<beta> \<AA>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<BB>: tiny_category \<beta> \<BB>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<CC>: tiny_category \<beta> \<CC>
	by (rule category.cat_tiny_category_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+

	interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<GG>: is_tiny_functor \<beta> \<CC> \<AA> \<GG>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+
	interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
	by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
	(use \<alpha>\<beta> in \<open>cs_concl cs_shallow cs_intro: cat_cs_intros\<close>)+

	interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
	by (rule AG.subcategory_cat_Set_cat_Set[OF \<beta> \<alpha>\<beta>])

	from assms(3) \<alpha>\<beta> interpret Hom_c: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>?H_\<CC> c\<close>
	by (cs_concl cs_intro: cat_cs_intros)

	( E' )

	define E' :: V where "E' =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
	(\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>),
	op_cat \<AA>,
	cat_Set \<beta>
	]\<^sub>\<circ> "

	have E'_components:
	"E'\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
	"E'\<lparr>ArrMap\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>)"
	"E'\<lparr>HomDom\<rparr> = op_cat \<AA>"
	"E'\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)

	note [cat_cs_simps] = E'_components(3,4)

	have E'_ObjMap_app[cat_cs_simps]:
	"E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that unfolding E'_components by simp
	have E'_ArrMap_app[cat_cs_simps]:
	"E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>"
	if "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" for f
	using that unfolding E'_components by simp

	have E': "E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof(intro is_functorI')

	show "vfsequence E'" unfolding E'_def by auto
	show "vcard E' = 4\<^sub>\<nat>" unfolding E'_def by (simp add: nat_omega_simps)
	show "vsv (E'\<lparr>ObjMap\<rparr>)" unfolding E'_components by simp
	show "vsv (E'\<lparr>ArrMap\<rparr>)" unfolding E'_components by simp
	show "\<D>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
	unfolding E'_components by (simp add: cat_op_simps)
	show "\<R>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	unfolding E'_components
	proof(rule vrange_VLambda_vsubset)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	then have "?H_\<AA>\<GG> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	with assms(3) prems show
	"?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Set_components(1)
	cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
	)
	qed
	show "\<D>\<^sub>\<circ> (E'\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>"
	unfolding E'_components by (simp add: cat_op_simps)
	show "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
	proof-
	from that[unfolded cat_op_simps] assms(3) show ?thesis
	by (intro cat_Set_\<alpha>\<beta>.subcat_is_arrD)
	(
	cs_concl
	cs_simp:
	category.cf_eval_ObjMap_app
	category.cf_eval_ArrMap_app
	E'_ObjMap_app
	E'_ArrMap_app
	cs_intro: cat_cs_intros
	)
	qed
	then have [cat_cs_intros]: "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> B"
	if "A = E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" and "B = E'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
	for a b f A B
	using that by (simp add: cat_op_simps)
	show
	"E'\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> = E'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for b c g a f
	proof-
	note g = that(1)[unfolded cat_op_simps]
	and f = that(2)[unfolded cat_op_simps]
	from g f assms(3) \<alpha>\<beta> show ?thesis
	by
	(
	cs_concl
	cs_intro:
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	cs_simp:
	cat_cs_simps
	cat_FUNCT_cs_simps
	cat_prod_cs_simps
	cat_op_simps
	E.cf_ArrMap_Comp[symmetric]
	)+
	qed

	show "E'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	proof(cs_concl_step cat_Set_\<alpha>\<beta>.subcat_CId[symmetric])
	from that[unfolded cat_op_simps] assms(3) show
	"E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros
	)
	from that[unfolded cat_op_simps] assms(3) show
	"E'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	by
	(
	cs_concl
	cs_intro: cat_cs_intros
	cs_simp:
	cat_Set_components(1)
	cat_cs_simps
	cat_op_simps
	ntcf_id_cf_comp[symmetric]
	)
	qed
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	then interpret E': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> E' by simp


	( N' )

	define N' :: V where "N' =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
	(\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>),
	op_cat \<AA>,
	cat_Set \<beta>
	]\<^sub>\<circ> "

	have N'_components:
	"N'\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
	"N'\<lparr>ArrMap\<rparr> =
	(\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>)"
	"N'\<lparr>HomDom\<rparr> = op_cat \<AA>"
	"N'\<lparr>HomCod\<rparr> = cat_Set \<beta>"
	unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)

	note [cat_cs_simps] = N'_components(3,4)

	have N'_ObjMap_app[cat_cs_simps]:
	"N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that unfolding N'_components by simp
	have N'_ArrMap_app[cat_cs_simps]:
	"N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>"
	if "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" for f
	using that unfolding N'_components by simp

	from \<alpha>\<beta> interpret cf_nt_\<CC>: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>?cf_nt\<close>
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	have N': "N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof(intro is_functorI')
	show "vfsequence N'" unfolding N'_def by simp
	show "vcard N' = 4\<^sub>\<nat>" unfolding N'_def by (simp add: nat_omega_simps)
	show "vsv (N'\<lparr>ObjMap\<rparr>)" unfolding N'_components by simp
	show "vsv (N'\<lparr>ArrMap\<rparr>)" unfolding N'_components by simp
	show "\<D>\<^sub>\<circ> (N'\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
	unfolding N'_components by (simp add: cat_op_simps)
	show "\<R>\<^sub>\<circ> (N'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	unfolding N'_components
	proof(rule vrange_VLambda_vsubset)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms(3) \<alpha>\<beta> show
	"?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros FUNCT_\<CC>.cat_Hom_in_Vset cat_FUNCT_cs_intros
	)
	qed
	show "\<D>\<^sub>\<circ> (N'\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>"
	unfolding N'_components by (simp add: cat_op_simps)
	show "N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
	using that[unfolded cat_op_simps] assms(3)
	by
	(
	cs_concl
	cs_simp: N'_ObjMap_app N'_ArrMap_app
	cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
	)
	show
	"N'\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> = N'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for b c g a f
	proof-
	from that assms(3) \<alpha>\<beta> show ?thesis
	unfolding cat_op_simps
	by
	(
	cs_concl
	cs_intro:
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	cs_simp:
	cat_cs_simps
	cat_FUNCT_cs_simps
	cat_prod_cs_simps
	cat_op_simps
	cf_nt_\<CC>.cf_ArrMap_Comp[symmetric]
	)
	qed
	show "N'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	proof-
	note [cat_cs_simps] =
	ntcf_id_cf_comp[symmetric]
	ntcf_arrow_id_ntcf_id[symmetric]
	cat_FUNCT_CId_app[symmetric]
	from that[unfolded cat_op_simps] assms(3) \<alpha>\<beta> show ?thesis
	by (very slow)
	(
	cs_concl
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
	)+
	qed
	qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	then interpret N': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> N' by simp


	( Y' )

	define Y' :: V where "Y' =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
	N',
	E',
	op_cat \<AA>,
	cat_Set \<beta>
	]\<^sub>\<circ>"

	have Y'_components:
	"Y'\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
	"Y'\<lparr>NTDom\<rparr> = N'"
	"Y'\<lparr>NTCod\<rparr> = E'"
	"Y'\<lparr>NTDGDom\<rparr> = op_cat \<AA>"
	"Y'\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
	unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)

	note [cat_cs_simps] = Y'_components(2-5)

	have Y'_NTMap_app[cat_cs_simps]:
	"Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that unfolding Y'_components by simp

	from \<beta> \<alpha>\<beta> interpret Y:
	is_iso_ntcf \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> ?cf_nt ?cf_eval \<open>ntcf_Yoneda \<alpha> \<beta> \<CC>\<close>
	by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)

	have Y': "Y' : N' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof(intro is_iso_ntcfI is_ntcfI')

	show "vfsequence Y'" unfolding Y'_def by simp
	show "vcard Y' = 5\<^sub>\<nat>"
	unfolding Y'_def by (simp add: nat_omega_simps)
	show "vsv (Y'\<lparr>NTMap\<rparr>)" unfolding Y'_components by auto
	show "\<D>\<^sub>\<circ> (Y'\<lparr>NTMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
	unfolding Y'_components by (simp add: cat_op_simps)
	show Y'_NTMap_a: "Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	- using that[unfolded cat_op_simps] assms(3)
	- by
	+ using that[unfolded cat_op_simps] assms(3) \<alpha>\<beta>
	+ by (slow)
	(
	cs_concl
	- cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	- cs_intro:
	- cat_arrow_cs_intros
	- cat_cs_intros
	- cat_prod_cs_intros
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
	+ cs_intro:
	+ cat_arrow_cs_intros
	+ cat_cs_intros
	+ cat_prod_cs_intros
	cat_FUNCT_cs_intros
	)
	then show "Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	- by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
	+ by (intro cat_Set_is_iso_arrD[OF Y'_NTMap_a[OF that]])
	show
	"Y'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
	proof-
	note f = that[unfolded cat_op_simps]
	from f assms(3) show ?thesis
	by
	(
	cs_concl
	cs_simp: cat_cs_simps Y.ntcf_Comp_commute
	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)+

	have E'_def: "E' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)"
	proof(rule cf_eqI)
	show "E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from assms(3) show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have dom_lhs: "\<D>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" unfolding E'_components by simp
	from assms(3) have dom_rhs:
	"\<D>\<^sub>\<circ> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	unfolding E'_components
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	show "E'\<lparr>ObjMap\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with assms(3) show "E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_op_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	qed (auto simp: E'_components cat_cs_intros assms(3))

	have dom_lhs: "\<D>\<^sub>\<circ> (E'\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" unfolding E'_components by simp
	from assms(3) have dom_rhs:
	"\<D>\<^sub>\<circ> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
	unfolding E'_components
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)

	show "E'\<lparr>ArrMap\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

	fix f assume prems: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
	then obtain a b where f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" by auto
	have [cat_cs_simps]:
	"cf_eval_arrow \<CC> (ntcf_arrow (?H_A\<GG> f)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) =
	cf_hom \<AA> [f, \<AA>\<lparr>CId\<rparr>\<lparr>?\<GG>c\<rparr>]\<^sub>\<circ>"
	(is \<open>?cf_eval_arrow = ?cf_hom_f\<GG>c\<close>)
	proof-
	have cf_eval_arrow_f_CId_\<GG>c:
	"?cf_eval_arrow :
	Hom \<AA> b ?\<GG>c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a ?\<GG>c"
	proof(rule cf_eval_arrow_is_arr')
	from f show "?H_A\<GG> f : ?H_\<AA>\<GG> b \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<GG> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros)
	qed
	(
	use f assms(3) in
	\<open>
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	\<close>
	)+
	from f assms(3) have dom_lhs:
	"\<D>\<^sub>\<circ> (?cf_eval_arrow\<lparr>ArrVal\<rparr>) = Hom \<AA> b ?\<GG>c"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)
	from assms(3) f Ran.HomCod.category_axioms have cf_hom_f\<GG>c:
	"?cf_hom_f\<GG>c :
	Hom \<AA> b ?\<GG>c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a ?\<GG>c"
	by
	(
	cs_concl cs_shallow cs_intro:
	cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	from f assms(3) have dom_rhs:
	"\<D>\<^sub>\<circ> (?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>) = Hom \<AA> b ?\<GG>c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	)

	show ?thesis
	proof(rule arr_Set_eqI)
	from cf_eval_arrow_f_CId_\<GG>c show "arr_Set \<alpha> ?cf_eval_arrow"
	by (auto dest: cat_Set_is_arrD(1))
	from cf_hom_f\<GG>c show "arr_Set \<alpha> ?cf_hom_f\<GG>c"
	by (auto dest: cat_Set_is_arrD(1))
	show "?cf_eval_arrow\<lparr>ArrVal\<rparr> = ?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
	from f assms(3) show "vsv (?cf_eval_arrow\<lparr>ArrVal\<rparr>)"
	by (cs_concl cs_intro: cat_cs_intros)
	from f assms(3) show "vsv (?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	fix g assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> ?\<GG>c"
	with f assms(3) show
	"?cf_eval_arrow\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	qed simp

	qed
	(
	use cf_eval_arrow_f_CId_\<GG>c cf_hom_f\<GG>c in
	\<open>cs_concl cs_simp: cat_cs_simps\<close>
	)+

	qed

	from f prems assms(3) show "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_op_simps cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros
	)

	qed (auto simp: E'_components cat_cs_intros assms(3))

	qed simp_all

	from Y' have inv_Y': "inv_ntcf Y' :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	- unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)
	+ unfolding E'_def by (auto intro: iso_ntcf_is_iso_arr)

	interpret N'': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> \<open>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<close>
	by (rule L_10_5_N_is_functor[OF \<beta> \<alpha>\<beta> assms])


	( \<psi> )

	define \<psi> :: V
	where "\<psi> =
	[
	(\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>),
	N',
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c,
	op_cat \<AA>,
	cat_Set \<beta>
	]\<^sub>\<circ>"

	have \<psi>_components:
	"\<psi>\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>)"
	"\<psi>\<lparr>NTDom\<rparr> = N'"
	"\<psi>\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c"
	"\<psi>\<lparr>NTDGDom\<rparr> = op_cat \<AA>"
	"\<psi>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
	unfolding \<psi>_def nt_field_simps by (simp_all add: nat_omega_simps)

	note [cat_cs_simps] = Y'_components(2-5)

	have \<psi>_NTMap_app[cat_cs_simps]:
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using that unfolding \<psi>_components by simp

	have \<psi>: "\<psi> : N' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	proof-

	show ?thesis
	proof(intro is_iso_ntcfI is_ntcfI')

	show "vfsequence \<psi>" unfolding \<psi>_def by auto
	show "vcard \<psi> = 5\<^sub>\<nat>" unfolding \<psi>_def by (simp_all add: nat_omega_simps)
	show "N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>" by (rule N')
	show "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "\<psi>\<lparr>NTDom\<rparr> = N'" unfolding \<psi>_components by simp
	show "\<psi>\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c" unfolding \<psi>_components by simp
	show "\<psi>\<lparr>NTDGDom\<rparr> = op_cat \<AA>" unfolding \<psi>_components by simp
	show "\<psi>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>" unfolding \<psi>_components by simp
	show "vsv (\<psi>\<lparr>NTMap\<rparr>)" unfolding \<psi>_components by simp
	show "\<D>\<^sub>\<circ> (\<psi>\<lparr>NTMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
	unfolding \<psi>_components by (simp add: cat_op_simps)

	- show \<psi>_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
	+ show \<psi>_NTMap_is_iso_arr[unfolded cat_op_simps]:
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	proof-
	note a = that[unfolded cat_op_simps]
	interpret \<epsilon>:
	is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> a\<close> \<epsilon>
	by (rule cat_pw_rKe_preserved[OF a])
	interpret a\<epsilon>:
	is_cat_rKe \<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> a\<close> \<open>?H_\<AA>\<GG> a\<close> \<open>?H_\<AA>\<epsilon> a\<close>
	by (rule \<epsilon>.cat_rKe_preserves)
	interpret is_iso_ntcf
	\<beta>
	\<open>op_cat (?FUNCT \<CC>)\<close>
	\<open>cat_Set \<beta>\<close>
	\<open>?H_FUNCT \<CC> (?H_\<AA>\<GG> a)\<close>
	\<open>?H_FUNCT \<BB> (?H_\<AA>\<TT> a) \<circ>\<^sub>C\<^sub>F op_cf ?SET_\<KK>\<close>
	\<open>?ntcf_ua_fo a\<close>
	by (rule a\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])
	have "cf_map (?H_\<CC> c) \<in>\<^sub>\<circ> ?FUNCT \<CC>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	from
	- iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this]
	+ iso_ntcf_is_iso_arr[unfolded cat_op_simps, OF this]
	a assms \<alpha>\<beta>
	show ?thesis
	by (very slow)
	(
	cs_prems
	cs_simp:
	cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps
	cs_intro:
	cat_small_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)
	qed
	show \<psi>_NTMap_is_arr[unfolded cat_op_simps]:
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
	by
	(
	- rule cat_Set_is_arr_isomorphismD[
	- OF \<psi>_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
	+ rule cat_Set_is_iso_arrD[
	+ OF \<psi>_NTMap_is_iso_arr[OF that[unfolded cat_op_simps]]
	]
	)

	show
	"\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> \<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
	proof-

	note f = that[unfolded cat_op_simps]
	from f have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto

	interpret p_a_\<epsilon>:
	is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> a\<close> \<epsilon>
	by (rule cat_pw_rKe_preserved[OF a])
	interpret a_\<epsilon>: is_cat_rKe
	\<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> a\<close> \<open>?H_\<AA>\<GG> a\<close> \<open>?H_\<AA>\<epsilon> a\<close>
	by (rule p_a_\<epsilon>.cat_rKe_preserves)
	interpret ntcf_ua_fo_a_\<epsilon>: is_iso_ntcf
	\<beta> ?ua_NTDGDom \<open>cat_Set \<beta>\<close> \<open>?ua_NTDom a\<close> \<open>?ua_NTCod a\<close> \<open>?ua a\<close>
	by (rule a_\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])

	interpret p_b_\<epsilon>:
	is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> b\<close> \<epsilon>
	by (rule cat_pw_rKe_preserved[OF b])
	interpret b_\<epsilon>: is_cat_rKe
	\<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> b\<close> \<open>?H_\<AA>\<GG> b\<close> \<open>?H_\<AA>\<epsilon> b\<close>
	by (rule p_b_\<epsilon>.cat_rKe_preserves)
	interpret ntcf_ua_fo_b_\<epsilon>: is_iso_ntcf
	\<beta> ?ua_NTDGDom \<open>cat_Set \<beta>\<close> \<open>?ua_NTDom b\<close> \<open>?ua_NTCod b\<close> \<open>?ua b\<close>
	by (rule b_\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])

	interpret \<KK>_SET: is_tiny_functor \<beta> \<open>?FUNCT \<CC>\<close> \<open>?FUNCT \<BB>\<close> ?SET_\<KK>
	by
	(
	rule exp_cat_cf_is_tiny_functor[
	OF \<beta> \<alpha>\<beta> AG.category_cat_Set AG.is_functor_axioms
	]
	)
	from f interpret Hom_f:
	is_ntcf \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<open>?H_\<AA> a\<close> \<open>?H_\<AA> b\<close> \<open>?H_A f\<close>
	by (cs_concl cs_intro: cat_cs_intros)

	let ?cf_hom_lhs =
	\<open>
	cf_hom
	(?FUNCT \<CC>)
	[ntcf_arrow (ntcf_id (?H_\<CC> c)), ntcf_arrow (?H_A\<GG> f)]\<^sub>\<circ>
	\<close>
	let ?cf_hom_rhs =
	\<open>
	cf_hom
	(?FUNCT \<BB>)
	[
	ntcf_arrow (ntcf_id (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)),
	ntcf_arrow (?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>)
	]\<^sub>\<circ>
	\<close>
	let ?dom =
	\<open>Hom (?FUNCT \<CC>) (cf_map (?H_\<CC> c)) (cf_map (?H_\<AA>\<GG> a))\<close>
	let ?cod = \<open>Hom (?FUNCT \<BB>) (cf_map (?H_\<CC>\<KK> c)) (cf_map (?H_\<AA>\<TT> b))\<close>
	let ?cf_hom_lhs_umap_fo_inter =
	\<open>Hom (?FUNCT \<CC>) (cf_map (?H_\<CC> c)) (cf_map (?H_\<AA>\<GG> b))\<close>
	let ?umap_fo_cf_hom_rhs_inter =
	\<open>Hom (?FUNCT \<BB>) (cf_map (?H_\<CC>\<KK> c)) (cf_map (?H_\<AA>\<TT> a))\<close>

	have [cat_cs_simps]:
	"?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs =
	?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a"
	proof-

	from f assms(3) \<alpha>\<beta> have cf_hom_lhs:
	"?cf_hom_lhs : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs_umap_fo_inter"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	from f assms(3) \<alpha>\<beta> have umap_fo_b:
	"?umap_fo b : ?cf_hom_lhs_umap_fo_inter \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
	"?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	)
	then have dom_umap_fo_cf_hom_lhs:
	"\<D>\<^sub>\<circ> ((?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>) = ?dom"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	)

	from f assms(3) \<alpha>\<beta> have cf_hom_rhs:
	"?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	from f assms(3) \<alpha>\<beta> have umap_fo_a:
	"?umap_fo a : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo_cf_hom_rhs_inter"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro:
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	)
	from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a:
	"?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	)
	then have dom_cf_hom_rhs_umap_fo_a:
	"\<D>\<^sub>\<circ> ((?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>) = ?dom"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	)

	show ?thesis
	proof(rule arr_Set_eqI)

	from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs:
	"arr_Set \<beta> (?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)"
	by (auto dest: cat_Set_is_arrD(1))
	from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a:
	"arr_Set \<beta> (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)"
	by (auto dest: cat_Set_is_arrD(1))

	show
	"(?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr> =
	(?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>"
	proof
	(
	rule vsv_eqI,
	unfold
	dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff;
	(rule refl)?
	)

	fix \<HH> assume prems:
	"\<HH> : cf_map (?H_\<CC> c) \<mapsto>\<^bsub>?FUNCT \<CC>\<^esub> cf_map (?H_\<AA>\<GG> a)"

	let ?\<HH> = \<open>ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<HH>\<close>
	let ?lhs = \<open>?H_\<AA>\<epsilon> b \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ((?H_A\<GG> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<HH>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<close>
	let ?rhs =
	\<open>(?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_\<AA>\<epsilon> a \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<HH> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<close>
	let ?cf_hom_\<AA>\<epsilon> = \<open>\<lambda>b b'. cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>]\<^sub>\<circ>\<close>
	let ?Yc = \<open>\<lambda>Q. Yoneda_component (?H_\<AA> b) a f Q\<close>
	let ?\<HH>\<KK> = \<open>\<lambda>b'. ?\<HH>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
	let ?\<GG>\<KK> = \<open>\<lambda>b'. \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>

	have [cat_cs_simps]:
	"cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map (?H_\<CC> c)) = ?H_\<CC> c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	have [cat_cs_simps]:
	"cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map (?H_\<AA>\<GG> a)) = ?H_\<AA>\<GG> a"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	)
	note \<HH> = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
	have Hom_c: "?H_\<CC>\<KK> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

	have [cat_cs_simps]: "?lhs = ?rhs"
	proof(rule ntcf_eqI)
	from \<HH>(1) f show lhs:
	"?lhs : ?H_\<CC>\<KK> c \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<TT> b : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_simp: cs_intro: cat_cs_intros)
	then have dom_lhs: "\<D>\<^sub>\<circ> (?lhs\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)+
	from \<HH>(1) f show rhs:
	"?rhs : ?H_\<CC>\<KK> c \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<TT> b : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> (?rhs\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
	by (cs_concl cs_simp: cat_cs_simps)+
	have [cat_cs_simps]:
	"?cf_hom_\<AA>\<epsilon> b b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	(?Yc (?\<GG>\<KK> b') \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<HH>\<KK> b') =
	?Yc (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	(?cf_hom_\<AA>\<epsilon> a b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<HH>\<KK> b')"
	(is \<open>?lhs_Set = ?rhs_Set\<close>)
	if "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b'
	proof-
	let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
	from \<HH>(1) f that assms(3) Ran.HomCod.category_axioms
	have lhs_Set_is_arr: "?lhs_Set :
	Hom \<CC> c (?\<KK>b') \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro:
	cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	then have dom_lhs_Set: "\<D>\<^sub>\<circ> (?lhs_Set\<lparr>ArrVal\<rparr>) = Hom \<CC> c ?\<KK>b'"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from \<HH>(1) f that assms(3) Ran.HomCod.category_axioms
	have rhs_Set_is_arr: "?rhs_Set :
	Hom \<CC> c (?\<KK>b') \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro:
	cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	then have dom_rhs_Set: "\<D>\<^sub>\<circ> (?rhs_Set\<lparr>ArrVal\<rparr>) = Hom \<CC> c ?\<KK>b'"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show ?thesis
	proof(rule arr_Set_eqI)
	from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set \<alpha> ?lhs_Set"
	by (auto dest: cat_Set_is_arrD(1))
	from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set \<alpha> ?rhs_Set"
	by (auto dest: cat_Set_is_arrD(1))
	show "?lhs_Set\<lparr>ArrVal\<rparr> = ?rhs_Set\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
	fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
	with \<HH>(1) f that assms Ran.HomCod.category_axioms show
	"?lhs_Set\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = ?rhs_Set\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	by (exceptionally slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro:
	cat_cs_intros cat_prod_cs_intros cat_op_intros
	)
	qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
	qed
	(
	use lhs_Set_is_arr rhs_Set_is_arr in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>
	)+

	qed

	show "?lhs\<lparr>NTMap\<rparr> = ?rhs\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix b' assume "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	with \<HH>(1) f assms(3) show "?lhs\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = ?rhs\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros
	)
	- qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ qed (cs_concl cs_intro: cat_cs_intros)

	qed simp_all

	from
	assms(3) f \<HH>(1) prems \<alpha>\<beta>
	(speedup)
	Ran.HomCod.category_axioms
	FUNCT_\<CC>.category_axioms
	FUNCT_\<BB>.category_axioms
	AG.is_functor_axioms
	Ran.is_functor_axioms
	Hom_f.is_ntcf_axioms
	show
	"(?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>\<lparr>\<HH>\<rparr> =
	(?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>\<lparr>\<HH>\<rparr>"
	by (subst (1 2) \<HH>(2)) (exceptionally slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
	cs_intro:
	cat_cs_intros
	cat_prod_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)
	qed
	(
	use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
	auto
	)

	qed
	(
	use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
	\<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>
	)+

	qed

	from f assms \<alpha>\<beta> show ?thesis
	by (slow)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	)

	qed

	qed auto

	qed


	(main)

	from L_10_5_\<chi>_is_iso_ntcf[OF \<beta> \<alpha>\<beta> assms] have inv_\<chi>:
	"inv_ntcf (L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c) :
	L_10_5_N \<alpha> \<beta> \<TT> \<KK> c \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	- by (auto intro: iso_ntcf_is_arr_isomorphism)
	+ by (auto intro: iso_ntcf_is_iso_arr)

	define \<phi> where "\<phi> = inv_ntcf (L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf Y'"

	from inv_Y' \<psi> inv_\<chi> have \<phi>: "\<phi> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
	unfolding \<phi>_def by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	interpret \<phi>: is_iso_ntcf
	\<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<close> \<open>cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK>\<close> \<phi>
	by (rule \<phi>)

	let ?\<phi>_\<GG>c_CId = \<open>\<phi>\<lparr>NTMap\<rparr>\<lparr>?\<GG>c\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>?\<GG>c\<rparr>\<rparr>\<close>
	let ?ntcf_\<phi>_\<GG>c_CId = \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> ?\<phi>_\<GG>c_CId\<close>

	from AG.vempty_is_zet assms(3) have \<Delta>: "?\<Delta> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> ?c\<KK>_\<AA>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_comma_cs_simps
	cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms(3) have \<GG>c: "?\<GG>c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from AG.vempty_is_zet have \<TT>_c\<KK>: "cf_map (?\<TT>_c\<KK>) \<in>\<^sub>\<circ> ?c\<KK>_\<AA>\<lparr>Obj\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_FUNCT_components(1)
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)

	from
	\<phi>.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF \<GG>c]
	assms(3)
	AG.vempty_is_zet
	\<beta>.vempty_is_zet
	\<alpha>\<beta>
	have \<phi>_\<GG>c: "\<phi>\<lparr>NTMap\<rparr>\<lparr>?\<GG>c\<rparr> :
	Hom \<AA> ?\<GG>c?\<GG>c \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
	Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> ?\<GG>c)) (cf_map ?\<TT>_c\<KK>)"
	by (very slow)
	(
	cs_prems
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	cat_comma_cs_simps
	cat_op_simps
	cat_FUNCT_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_comma_cs_intros
	cat_cs_intros
	cat_FUNCT_cs_intros
	cat_op_intros
	)

	with assms(3) have \<phi>_\<GG>c_CId:
	"?\<phi>_\<GG>c_CId : cf_map (?cf_c\<KK>_\<AA> ?\<GG>c) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map ?\<TT>_c\<KK>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	have ntcf_arrow_\<phi>_\<GG>c_CId: "ntcf_arrow ?ntcf_\<phi>_\<GG>c_CId = ?\<phi>_\<GG>c_CId"
	by (rule cat_FUNCT_is_arrD(2)[OF \<phi>_\<GG>c_CId, symmetric])

	have ua: "universal_arrow_fo ?\<Delta> (cf_map (?\<TT>_c\<KK>)) ?\<GG>c ?\<phi>_\<GG>c_CId"
	by
	(
	rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf[
	OF \<Delta> \<GG>c \<TT>_c\<KK> \<phi>[unfolded cf_Cone_def cat_cs_simps]
	]
	)
	moreover have ntcf_\<phi>_\<GG>c_CId:
	"?ntcf_\<phi>_\<GG>c_CId : ?\<GG>c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof(intro is_cat_coneI)
	from cat_FUNCT_is_arrD(1)[OF \<phi>_\<GG>c_CId] assms(3) AG.vempty_is_zet show
	"ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> ?\<phi>_\<GG>c_CId :
	?cf_c\<KK>_\<AA> ?\<GG>c \<mapsto>\<^sub>C\<^sub>F ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_FUNCT_cs_simps
	cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	)
	qed (rule \<GG>c)
	ultimately have "?ntcf_\<phi>_\<GG>c_CId : ?\<GG>c <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro is_cat_cone.cat_cone_is_cat_limit)
	(simp_all add: ntcf_arrow_\<phi>_\<GG>c_CId)
	then show ?thesis using that by auto

	qed

	lemma (in is_cat_pw_lKe) cat_pw_lKe_ex_cat_colimit:
	\<comment>\<open>Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	obtains UA
	where "UA : \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from
	is_cat_pw_rKe.cat_pw_rKe_ex_cat_limit
	[
	OF is_cat_pw_rKe_op AG.is_functor_op ntcf_lKe.NTDom.is_functor_op,
	unfolded cat_op_simps,
	OF assms(3)
	]
	obtain UA where UA: "UA :
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) :
	c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
	by auto
	from assms(3) have [cat_cs_simps]:
	"op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<KK> c =
	op_cf \<TT> \<circ>\<^sub>C\<^sub>F op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps AG.op_cf_cf_obj_comma_proj[OF assms(3)]
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	from assms(3) have [cat_op_simps]:
	"\<TT> \<circ>\<^sub>C\<^sub>F op_cf (c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>)) \<circ>\<^sub>C\<^sub>F op_cf (op_cf_obj_comma \<KK> c) =
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_cs_simps cat_op_simps
	op_cf_cf_comp[symmetric] AG.op_cf_cf_obj_comma_proj[symmetric]
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	from assms(3) have [cat_op_simps]: "op_cat (op_cat (\<KK> \<^sub>C\<^sub>F\<down> c)) = \<KK> \<^sub>C\<^sub>F\<down> c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	note ntcf_cf_comp_is_cat_limit_if_is_iso_functor =
	ntcf_cf_comp_is_cat_limit_if_is_iso_functor
	[
	OF UA AG.op_cf_obj_comma_is_iso_functor[OF assms(3)],
	unfolded cat_op_simps
	]
	have "op_ntcf UA \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf (op_cf_obj_comma \<KK> c) :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	rule is_cat_limit.is_cat_colimit_op
	[
	OF ntcf_cf_comp_is_cat_limit_if_is_iso_functor,
	unfolded cat_op_simps
	]
	)
	then show ?thesis using that by auto
	qed



	subsection\<open>The limit and the colimit for the pointwise Kan extensions\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>See Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>

	definition the_pw_cat_rKe_limit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c =
	[
	\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>,
	(
	SOME UA.
	UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<TT>\<lparr>HomCod\<rparr>
	)
	]\<^sub>\<circ>"

	definition the_pw_cat_lKe_colimit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c =
	[
	\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>,
	op_ntcf
	(
	the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	op_cf_obj_comma \<KK> c
	)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma the_pw_cat_rKe_limit_components:
	shows "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UObj\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	and "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UArr\<rparr> =
	(
	SOME UA.
	UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<TT>\<lparr>HomCod\<rparr>
	)"
	unfolding the_pw_cat_rKe_limit_def ua_field_simps
	by (simp_all add: nat_omega_simps)

	lemma the_pw_cat_lKe_colimit_components:
	shows "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	and "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UArr\<rparr> = op_ntcf
	(
	the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	op_cf_obj_comma \<KK> c
	)"
	unfolding the_pw_cat_lKe_colimit_def ua_field_simps
	by (simp_all add: nat_omega_simps)

	context is_functor
	begin

	lemmas the_pw_cat_rKe_limit_components' =
	the_pw_cat_rKe_limit_components[where \<TT>=\<FF>, unfolded cat_cs_simps]

	end


	subsubsection\<open>
	The limit for the pointwise right Kan extension is a limit,
	the colimit for the pointwise left Kan extension is a colimit
	\<close>

	lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UArr\<rparr> :
	the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> :
	c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA
	where UA: "UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by auto
	show ?thesis
	unfolding the_pw_cat_rKe_limit_components
	by (rule someI2, unfold cat_cs_simps, rule UA)
	qed

	lemma (in is_cat_pw_lKe) cat_pw_lKe_the_pw_cat_lKe_colimit_is_cat_colimit:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	shows "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UArr\<rparr> :
	\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr> :
	\<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-
	interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	note cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit =
	is_cat_pw_rKe.cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit
	[
	OF is_cat_pw_rKe_op AG.is_functor_op ntcf_lKe.NTDom.is_functor_op,
	unfolded cat_op_simps,
	OF assms(3)
	]
	from assms(3) have
	"op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<KK> c =
	op_cf \<TT> \<circ>\<^sub>C\<^sub>F op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)"
	by
	(
	cs_concl cs_shallow
	cs_simp:
	cat_cs_simps cat_comma_cs_simps cat_op_simps
	AG.op_cf_cf_obj_comma_proj[OF assms(3)]
	cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
	)
	note ntcf_cf_comp_is_cat_limit_if_is_iso_functor =
	ntcf_cf_comp_is_cat_limit_if_is_iso_functor
	[
	OF
	cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit
	AG.op_cf_obj_comma_is_iso_functor[OF assms(3)],
	unfolded this, folded op_cf_cf_comp
	]
	from assms(3) have [cat_op_simps]: "op_cat (op_cat (\<KK> \<^sub>C\<^sub>F\<down> c)) = \<KK> \<^sub>C\<^sub>F\<down> c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	from assms(3) have [cat_op_simps]: "op_cf (op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)) = \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros
	)
	have [cat_op_simps]:
	"the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UObj\<rparr> =
	the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr>"
	unfolding
	the_pw_cat_lKe_colimit_components
	the_pw_cat_rKe_limit_components
	cat_op_simps
	by simp
	show ?thesis
	by
	(
	rule is_cat_limit.is_cat_colimit_op
	[
	OF ntcf_cf_comp_is_cat_limit_if_is_iso_functor,
	folded the_pw_cat_lKe_colimit_components,
	unfolded cat_op_simps
	]
	)
	qed

	lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) :
	the_cf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
	\<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	show "the_ntcf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) :
	the_cf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
	\<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	by
	(
	rule
	the_ntcf_rKe_is_cat_rKe
	[
	OF
	assms(1)
	ntcf_rKe.NTCod.is_functor_axioms
	cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit[OF assms]
	]
	)
	qed

	lemma (in is_cat_pw_lKe) cat_pw_lKe_the_ntcf_lKe_is_cat_lKe:
	assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "the_ntcf_lKe \<alpha> \<TT> \<KK> (the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF>) :
	\<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> the_cf_lKe \<alpha> \<TT> \<KK> (the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF>) \<circ>\<^sub>C\<^sub>F \<KK> :
	\<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
	proof-
	interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
	show ?thesis
	by
	(
	rule the_ntcf_lKe_is_cat_lKe
	[
	OF
	assms(1,2)
	cat_pw_lKe_the_pw_cat_lKe_colimit_is_cat_colimit[OF assms],
	simplified
	]
	)
	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan_Example.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan_Example.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan_Example.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan_Example.thy
	@@ -1,2445 +1,2445 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Pointwise Kan extensions: application example\<close>
	theory CZH_UCAT_PWKan_Example
	imports
	CZH_Elementary_Categories.CZH_ECAT_Ordinal
	CZH_UCAT_PWKan
	begin



	subsection\<open>Background\<close>


	text\<open>
	The application example presented in this section is based on
	Exercise 6.1.ii in \cite{riehl_category_2016}. The primary purpose
	of this section is the instantiation of the locales associated
	with the pointwise Kan extensions.
	\<close>

	(TODO: is the explicit elimination rule necessary?)
	lemma cat_ordinal_2_is_arrE:
	assumes "f : a \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> b"
	obtains "f = [0, 0]\<^sub>\<circ>" and "a = 0" and "b = 0"
	\| "f = [0, 1\<^sub>\<nat>]\<^sub>\<circ>" and "a = 0" and "b = 1\<^sub>\<nat>"
	\| "f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ>" and "a = 1\<^sub>\<nat>" and "b = 1\<^sub>\<nat>"
	using cat_ordinal_is_arrD[OF assms] unfolding two by auto

	(TODO: is the explicit elimination rule necessary?)
	lemma cat_ordinal_3_is_arrE:
	assumes "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b"
	obtains "f = [0, 0]\<^sub>\<circ>" and " a = 0" and "b = 0"
	\| "f = [0, 1\<^sub>\<nat>]\<^sub>\<circ>" and "a = 0" and "b = 1\<^sub>\<nat>"
	\| "f = [0, 2\<^sub>\<nat>]\<^sub>\<circ>" and "a = 0" and "b = 2\<^sub>\<nat>"
	\| "f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ>" and "a = 1\<^sub>\<nat>" and "b = 1\<^sub>\<nat>"
	\| "f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>" and "a = 1\<^sub>\<nat>" and "b = 2\<^sub>\<nat>"
	\| "f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>" and "a = 2\<^sub>\<nat>" and "b = 2\<^sub>\<nat>"
	using cat_ordinal_is_arrD[OF assms] unfolding three by auto

	lemma 0123: "0 \<in>\<^sub>\<circ> 2\<^sub>\<nat>" "1\<^sub>\<nat> \<in>\<^sub>\<circ> 2\<^sub>\<nat>" "0 \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "1\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "2\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" by auto



	subsection\<open>\<open>\<KK>23\<close>\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition \<KK>23 :: V
	where "\<KK>23 =
	[
	(\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (2\<^sub>\<nat>)\<lparr>Obj\<rparr>. if a = 0 then 0 else 2\<^sub>\<nat>),
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> [0, 0]\<^sub>\<circ>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> [0, 2\<^sub>\<nat>]\<^sub>\<circ>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>
	\| otherwise \<Rightarrow> 0
	),
	cat_ordinal (2\<^sub>\<nat>),
	cat_ordinal (3\<^sub>\<nat>)
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma \<KK>23_components:
	shows "\<KK>23\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (2\<^sub>\<nat>)\<lparr>Obj\<rparr>. if a = 0 then 0 else 2\<^sub>\<nat>)"
	and "\<KK>23\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> [0, 0]\<^sub>\<circ>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> [0, 2\<^sub>\<nat>]\<^sub>\<circ>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>
	\| otherwise \<Rightarrow> 0
	)"
	and [cat_Kan_cs_simps]: "\<KK>23\<lparr>HomDom\<rparr> = cat_ordinal (2\<^sub>\<nat>)"
	and [cat_Kan_cs_simps]: "\<KK>23\<lparr>HomCod\<rparr> = cat_ordinal (3\<^sub>\<nat>)"
	unfolding \<KK>23_def dghm_field_simps by (simp_all add: nat_omega_simps)


	subsubsection\<open>Object map\<close>

	mk_VLambda \<KK>23_components(1)
	\|vsv \<KK>23_ObjMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain \<KK>23_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app \<KK>23_ObjMap_app\|

	lemma \<KK>23_ObjMap_app_0[cat_Kan_cs_simps]:
	assumes "x = 0"
	shows "\<KK>23\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = 0"
	by
	(
	cs_concl
	cs_simp: \<KK>23_ObjMap_app cat_ordinal_cs_simps V_cs_simps assms
	cs_intro: nat_omega_intros
	)

	lemma \<KK>23_ObjMap_app_1[cat_Kan_cs_simps]:
	assumes "x = 1\<^sub>\<nat>"
	shows "\<KK>23\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> = 2\<^sub>\<nat>"
	by
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps V_cs_simps omega_of_set \<KK>23_ObjMap_app assms
	cs_intro: nat_omega_intros V_cs_intros
	)


	subsubsection\<open>Arrow map\<close>

	mk_VLambda \<KK>23_components(2)
	\|vsv \<KK>23_ArrMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain \<KK>23_ArrMap_vdomain[cat_Kan_cs_simps]\|
	\|app \<KK>23_ArrMap_app\|

	lemma \<KK>23_ArrMap_app_00[cat_Kan_cs_simps]:
	assumes "f = [0, 0]\<^sub>\<circ>"
	shows "\<KK>23\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = [0, 0]\<^sub>\<circ>"
	unfolding assms
	by
	(
	cs_concl
	cs_simp: \<KK>23_ArrMap_app cat_ordinal_cs_simps V_cs_simps
	cs_intro: cat_ordinal_cs_intros nat_omega_intros
	)

	lemma \<KK>23_ArrMap_app_01[cat_Kan_cs_simps]:
	assumes "f = [0, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "\<KK>23\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = [0, 2\<^sub>\<nat>]\<^sub>\<circ>"
	proof-
	have "[0, 1\<^sub>\<nat>]\<^sub>\<circ> \<in>\<^sub>\<circ> ordinal_arrs (2\<^sub>\<nat>)"
	by
	(
	cs_concl
	cs_simp: omega_of_set
	cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
	)
	then show ?thesis
	unfolding assms by (simp add: \<KK>23_components cat_ordinal_components)
	qed

	lemma \<KK>23_ArrMap_app_11[cat_Kan_cs_simps]:
	assumes "f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "\<KK>23\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>"
	proof-
	have "[1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<in>\<^sub>\<circ> ordinal_arrs (2\<^sub>\<nat>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: omega_of_set
	cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
	)
	then show ?thesis
	unfolding assms by (simp add: \<KK>23_components cat_ordinal_components)
	qed


	subsubsection\<open>\<open>\<KK>23\<close> is a tiny functor\<close>

	lemma (in \<Z>) \<KK>23_is_functor: "\<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_ordinal (3\<^sub>\<nat>)"
	proof-

	from ord_of_nat_\<omega> interpret cat_ordinal_2: finite_category \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)
	from ord_of_nat_\<omega> interpret cat_ordinal_3: finite_category \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)

	show ?thesis
	proof(intro is_tiny_functorI' is_functorI')

	show "vfsequence \<KK>23" unfolding \<KK>23_def by auto
	show "vcard \<KK>23 = 4\<^sub>\<nat>" unfolding \<KK>23_def by (simp add: nat_omega_simps)

	show "\<R>\<^sub>\<circ> (\<KK>23\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>"
	proof
	(
	rule vsv.vsv_vrange_vsubset,
	unfold cat_Kan_cs_simps cat_ordinal_cs_simps,
	intro cat_Kan_cs_intros
	)
	fix x assume "x \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>x = 0\<close> \| \<open>x = 1\<^sub>\<nat>\<close> unfolding two by auto
	then show "\<KK>23\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps omega_of_set cs_intro: nat_omega_intros
	)+
	qed

	show "\<KK>23\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<KK>23\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> \<KK>23\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> b" for a b f
	using that
	by (elim cat_ordinal_2_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: omega_of_set cat_Kan_cs_simps
	cs_intro: nat_omega_intros V_cs_intros cat_ordinal_cs_intros
	)

	show
	"\<KK>23\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> f\<rparr> =
	\<KK>23\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> \<KK>23\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> c" and "f : a \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> b"
	for b c g a f
	proof-
	have "0 \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "1\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "2\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" by auto
	then show ?thesis
	using that
	by (elim cat_ordinal_2_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_Kan_cs_simps
	cs_intro: V_cs_intros cat_ordinal_cs_intros
	)+
	qed

	show
	"\<KK>23\<lparr>ArrMap\<rparr>\<lparr>cat_ordinal (2\<^sub>\<nat>)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
	cat_ordinal (3\<^sub>\<nat>)\<lparr>CId\<rparr>\<lparr>\<KK>23\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> cat_ordinal (2\<^sub>\<nat>)\<lparr>Obj\<rparr>" for c
	proof-
	from that consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close>
	unfolding cat_ordinal_components(1) two by auto
	then show ?thesis
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp: omega_of_set cat_Kan_cs_simps cat_ordinal_cs_simps
	cs_intro: nat_omega_intros cat_ordinal_cs_intros
	)
	qed

	qed (auto intro!: cat_cs_intros simp: \<KK>23_components)

	qed

	lemma (in \<Z>) \<KK>23_is_functor'[cat_Kan_cs_intros]:
	assumes "\<AA>' = cat_ordinal (2\<^sub>\<nat>)"
	and "\<BB>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "\<KK>23 : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule \<KK>23_is_functor)

	lemmas [cat_Kan_cs_intros] = \<Z>.\<KK>23_is_functor'

	lemma (in \<Z>) \<KK>23_is_tiny_functor:
	"\<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> cat_ordinal (3\<^sub>\<nat>)"
	proof-
	from ord_of_nat_\<omega> interpret cat_ordinal_2: finite_category \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)
	from ord_of_nat_\<omega> interpret cat_ordinal_3: finite_category \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)
	show ?thesis
	by (intro is_tiny_functorI' \<KK>23_is_functor)
	(auto intro!: cat_small_cs_intros)
	qed

	lemma (in \<Z>) \<KK>23_is_tiny_functor'[cat_Kan_cs_intros]:
	assumes "\<AA>' = cat_ordinal (2\<^sub>\<nat>)"
	and "\<BB>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "\<KK>23 : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>'"
	unfolding assms by (rule \<KK>23_is_tiny_functor)

	lemmas [cat_Kan_cs_intros] = \<Z>.\<KK>23_is_tiny_functor'



	subsection\<open>
	\<open>LK23\<close>: the functor associated with the left Kan extension along \<^const>\<open>\<KK>23\<close>
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition LK23 :: "V \<Rightarrow> V"
	where "LK23 \<FF> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	),
	cat_ordinal (3\<^sub>\<nat>),
	\<FF>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma LK23_components:
	shows "LK23 \<FF>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>
	)"
	and "LK23 \<FF>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	)"
	and "LK23 \<FF>\<lparr>HomDom\<rparr> = cat_ordinal (3\<^sub>\<nat>)"
	and "LK23 \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding LK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

	context is_functor
	begin

	lemmas LK23_components' = LK23_components[where \<FF>=\<FF>, unfolded cat_cs_simps]

	lemmas [cat_Kan_cs_simps] = LK23_components'(3,4)

	end

	lemmas [cat_Kan_cs_simps] = is_functor.LK23_components'(3,4)


	subsubsection\<open>Object map\<close>

	mk_VLambda LK23_components(1)
	\|vsv LK23_ObjMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain LK23_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app LK23_ObjMap_app\|

	lemma LK23_ObjMap_app_0[cat_Kan_cs_simps]:
	assumes "a = 0"
	shows "LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
	unfolding LK23_components assms cat_ordinal_components by simp

	lemma LK23_ObjMap_app_1[cat_Kan_cs_simps]:
	assumes "a = 1\<^sub>\<nat>"
	shows "LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
	unfolding LK23_components assms cat_ordinal_components by simp

	lemma LK23_ObjMap_app_2[cat_Kan_cs_simps]:
	assumes "a = 2\<^sub>\<nat>"
	shows "LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	unfolding LK23_components assms cat_ordinal_components by simp


	subsubsection\<open>Arrow map\<close>

	mk_VLambda LK23_components(2)
	\|vsv LK23_ArrMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain LK23_ArrMap_vdomain[cat_Kan_cs_simps]\|
	\|app LK23_ArrMap_app\|

	lemma LK23_ArrMap_app_00[cat_Kan_cs_simps]:
	assumes "f = [0, 0]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by auto
	qed

	lemma LK23_ArrMap_app_01[cat_Kan_cs_simps]:
	assumes "f = [0, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by auto
	qed

	lemma LK23_ArrMap_app_02[cat_Kan_cs_simps]:
	assumes "f = [0, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by auto
	qed

	lemma LK23_ArrMap_app_11[cat_Kan_cs_simps]:
	assumes "f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by auto
	qed

	lemma LK23_ArrMap_app_12[cat_Kan_cs_simps]:
	assumes "f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: omega_of_set
	cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by auto
	qed

	lemma LK23_ArrMap_app_22[cat_Kan_cs_simps]:
	assumes "f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding LK23_components assms by simp
	qed


	subsubsection\<open>\<open>LK23\<close> is a functor\<close>

	lemma cat_LK23_is_functor:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "LK23 \<FF> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms(1))

	from ord_of_nat_\<omega> interpret cat_ordinal_2: finite_category \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)
	from ord_of_nat_\<omega> interpret cat_ordinal_3: finite_category \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms)

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (LK23 \<FF>)" unfolding LK23_def by auto
	show "vcard (LK23 \<FF>) = 4\<^sub>\<nat>" unfolding LK23_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (LK23 \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
	fix x assume prems: "x \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>"
	then consider \<open>x = 0\<close> \| \<open>x = 1\<^sub>\<nat>\<close> \| \<open>x = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_cs_simps three by auto
	then show "LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
	cs_intro: cat_cs_intros nat_omega_intros
	)+
	qed (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	show "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b" for a b f
	proof-
	from 0123 that show ?thesis
	by (elim cat_ordinal_3_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	qed
	show
	"LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> f\<rparr> =
	LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> c" and "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b"
	for b c g a f
	proof-
	from 0123 that show ?thesis
	by (elim cat_ordinal_3_is_arrE; simp only:; (solves\<open>simp\<close>)?) (slow)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	\<FF>.cf_ArrMap_Comp[symmetric]
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	qed
	show "LK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>cat_ordinal (3\<^sub>\<nat>)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>LK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>" for c
	proof-
	from that consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_components three by auto
	moreover have "0 \<in>\<^sub>\<circ> 2\<^sub>\<nat>" "1\<^sub>\<nat> \<in>\<^sub>\<circ> 2\<^sub>\<nat>" "0 \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "1\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" "2\<^sub>\<nat> \<in>\<^sub>\<circ> 3\<^sub>\<nat>" by auto
	ultimately show ?thesis
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	is_functor.cf_ObjMap_CId[symmetric]
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	qed
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma cat_LK23_is_functor'[cat_Kan_cs_intros]:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "LK23 \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1) unfolding assms(2) by (rule cat_LK23_is_functor)


	subsubsection\<open>The fundamental property of \<open>LK23\<close>\<close>

	lemma cf_comp_LK23_\<KK>23[cat_Kan_cs_simps]:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23 = \<FF>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms(1))
	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret LK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<CC> \<open>LK23 \<FF>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule cf_eqI)
	show "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr>) = 2\<^sub>\<nat>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
	)
	have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	show "(LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> by force
	then show "(LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)+
	qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)+
	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr>) = cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume prems: "f \<in>\<^sub>\<circ> cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	then obtain a b where "f : a \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> b" by auto
	then show "(LK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (elim cat_ordinal_2_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	)+
	qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
	qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	qed



	subsection\<open>
	\<open>RK23\<close>: the functor associated with the right Kan extension along \<^const>\<open>\<KK>23\<close>
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition RK23 :: "V \<Rightarrow> V"
	where "RK23 \<FF> =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>
	),
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [0, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	),
	cat_ordinal (3\<^sub>\<nat>),
	\<FF>\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma RK23_components:
	shows "RK23 \<FF>\<lparr>ObjMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>
	)"
	and "RK23 \<FF>\<lparr>ArrMap\<rparr> =
	(
	\<lambda>f\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>.
	if f = [0, 0]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>
	\| f = [0, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [0, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> \<Rightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| otherwise \<Rightarrow> \<FF>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	)"
	and "RK23 \<FF>\<lparr>HomDom\<rparr> = cat_ordinal (3\<^sub>\<nat>)"
	and "RK23 \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
	unfolding RK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

	context is_functor
	begin

	lemmas RK23_components' = RK23_components[where \<FF>=\<FF>, unfolded cat_cs_simps]

	lemmas [cat_Kan_cs_simps] = RK23_components'(3,4)

	end

	lemmas [cat_Kan_cs_simps] = is_functor.RK23_components'(3,4)


	subsubsection\<open>Object map\<close>

	mk_VLambda RK23_components(1)
	\|vsv RK23_ObjMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain RK23_ObjMap_vdomain[cat_Kan_cs_simps]\|
	\|app RK23_ObjMap_app\|

	lemma RK23_ObjMap_app_0[cat_Kan_cs_simps]:
	assumes "a = 0"
	shows "RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
	unfolding RK23_components assms cat_ordinal_components by simp

	lemma RK23_ObjMap_app_1[cat_Kan_cs_simps]:
	assumes "a = 1\<^sub>\<nat>"
	shows "RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	unfolding RK23_components assms cat_ordinal_components by simp

	lemma RK23_ObjMap_app_2[cat_Kan_cs_simps]:
	assumes "a = 2\<^sub>\<nat>"
	shows "RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	unfolding RK23_components assms cat_ordinal_components by simp


	subsubsection\<open>Arrow map\<close>

	mk_VLambda RK23_components(2)
	\|vsv RK23_ArrMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain RK23_ArrMap_vdomain[cat_Kan_cs_simps]\|
	\|app RK23_ArrMap_app\|

	lemma RK23_ArrMap_app_00[cat_Kan_cs_simps]:
	assumes "f = [0, 0]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 0\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow cs_intro:
	V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by auto
	qed

	lemma RK23_ArrMap_app_01[cat_Kan_cs_simps]:
	assumes "f = [0, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow cs_intro:
	V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by auto
	qed

	lemma RK23_ArrMap_app_02[cat_Kan_cs_simps]:
	assumes "f = [0, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow cs_intro:
	V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by auto
	qed

	lemma RK23_ArrMap_app_11[cat_Kan_cs_simps]:
	assumes "f = [1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow cs_intro:
	V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by auto
	qed

	lemma RK23_ArrMap_app_12[cat_Kan_cs_simps]:
	assumes "f = [1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: omega_of_set
	cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by auto
	qed

	lemma RK23_ArrMap_app_22[cat_Kan_cs_simps]:
	assumes "f = [2\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ>"
	shows "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	proof-
	from 0123 have f: "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow cs_intro:
	nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
	)
	then show ?thesis unfolding RK23_components assms by simp
	qed


	subsubsection\<open>\<open>RK23\<close> is a functor\<close>

	lemma cat_RK23_is_functor:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "RK23 \<FF> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms(1))

	from ord_of_nat_\<omega> interpret cat_ordinal_2: finite_category \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)
	from ord_of_nat_\<omega> interpret cat_ordinal_3: finite_category \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms)

	show ?thesis
	proof(intro is_functorI')
	show "vfsequence (RK23 \<FF>)" unfolding RK23_def by auto
	show "vcard (RK23 \<FF>) = 4\<^sub>\<nat>" unfolding RK23_def by (simp add: nat_omega_simps)
	show "\<R>\<^sub>\<circ> (RK23 \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
	fix x assume prems: "x \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>"
	then consider \<open>x = 0\<close> \| \<open>x = 1\<^sub>\<nat>\<close> \| \<open>x = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_cs_simps three by auto
	then show "RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	by cases
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
	cs_intro: cat_cs_intros nat_omega_intros
	)+
	qed (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	show "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
	if "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b" for a b f
	proof-
	from 0123 that show ?thesis
	by (elim cat_ordinal_3_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	qed
	show
	"RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> f\<rparr> =
	RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	if "g : b \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> c" and "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b"
	for b c g a f
	using 0123 that
	by (elim cat_ordinal_3_is_arrE; simp only:; (solves\<open>simp\<close>)?) (slow)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	\<FF>.cf_ArrMap_Comp[symmetric]
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	show "RK23 \<FF>\<lparr>ArrMap\<rparr>\<lparr>cat_ordinal (3\<^sub>\<nat>)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>RK23 \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
	if "c \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>" for c
	proof-
	from that consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_components three by auto
	then show ?thesis
	by (cases, use 0123 in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	is_functor.cf_ObjMap_CId[symmetric]
	cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
	)+
	qed
	qed
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma cat_RK23_is_functor'[cat_Kan_cs_intros]:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<AA>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "RK23 \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	using assms(1) unfolding assms(2) by (rule cat_RK23_is_functor)


	subsubsection\<open>The fundamental property of \<open>RK23\<close>\<close>

	lemma cf_comp_RK23_\<KK>23[cat_Kan_cs_simps]:
	assumes "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	shows "RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23 = \<FF>"
	proof-

	interpret \<FF>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<CC> \<FF> by (rule assms(1))
	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret RK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<CC> \<open>RK23 \<FF>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule cf_eqI)
	show "\<FF> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms)
	have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr>) = 2\<^sub>\<nat>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
	)
	have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	show "(RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> by force
	then show "(RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)+
	qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)+
	have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr>) = cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "(RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume prems: "f \<in>\<^sub>\<circ> cat_ordinal (2\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	then obtain a b where "f : a \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> b" by auto
	then show "(RK23 \<FF> \<circ>\<^sub>C\<^sub>F \<KK>23)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (elim cat_ordinal_2_is_arrE; simp only:)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
	)+
	qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
	qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	qed



	subsection\<open>
	\<open>RK_\<sigma>23\<close>: towards the universal property of the right Kan extension along \<open>\<KK>23\<close>
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition RK_\<sigma>23 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 2\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	),
	\<FF>',
	RK23 \<TT>,
	cat_ordinal (3\<^sub>\<nat>),
	\<FF>'\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma RK_\<sigma>23_components:
	shows "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 2\<^sub>\<nat>\<rparr>\<^sub>\<bullet>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	)"
	and "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTDom\<rparr> = \<FF>'"
	and "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTCod\<rparr> = RK23 \<TT>"
	and "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTDGDom\<rparr> = cat_ordinal (3\<^sub>\<nat>)"
	and "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTDGCod\<rparr> = \<FF>'\<lparr>HomCod\<rparr>"
	unfolding RK_\<sigma>23_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<FF>' \<TT>
	assumes \<FF>': "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and \<TT>: "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule \<FF>')
	interpretation \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule \<TT>)

	lemmas RK_\<sigma>23_components' =
	RK_\<sigma>23_components[where \<FF>'=\<FF>' and \<TT>=\<TT>, unfolded cat_cs_simps]

	lemmas [cat_Kan_cs_simps] = RK_\<sigma>23_components'(2-5)

	end


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda RK_\<sigma>23_components(1)
	\|vsv RK_\<sigma>23_NTMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain RK_\<sigma>23_NTMap_vdomain[cat_Kan_cs_simps]\|
	\|app RK_\<sigma>23_NTMap_app\|

	lemma RK_\<sigma>23_NTMap_app_0[cat_Kan_cs_simps]:
	assumes "a = 0"
	shows "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	using assms unfolding RK_\<sigma>23_components cat_ordinal_cs_simps by simp

	lemma (in is_functor) RK_\<sigma>23_NTMap_app_1[cat_Kan_cs_simps]:
	assumes "a = 1\<^sub>\<nat>"
	shows "RK_\<sigma>23 \<FF> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 2\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	using assms
	unfolding RK_\<sigma>23_components cat_ordinal_cs_simps cat_cs_simps
	by simp

	lemmas [cat_Kan_cs_simps] = is_functor.RK_\<sigma>23_NTMap_app_1

	lemma RK_\<sigma>23_NTMap_app_2[cat_Kan_cs_simps]:
	assumes "a = 2\<^sub>\<nat>"
	shows "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	using assms unfolding RK_\<sigma>23_components cat_ordinal_cs_simps by simp


	subsubsection\<open>\<open>RK_\<sigma>23\<close> is a natural transformation\<close>

	lemma RK_\<sigma>23_is_ntcf:
	assumes "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<epsilon>' : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	interpret \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(2))
	interpret \<epsilon>': is_ntcf \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close> \<TT> \<epsilon>'
	by (rule assms(3))

	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret RK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>RK23 \<TT>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	from 0123 have [cat_cs_simps]: "\<TT>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> = \<AA>\<lparr>CId\<rparr>\<lparr>\<TT>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
	cs_intro: cat_cs_intros
	)

	show ?thesis
	proof(rule is_ntcfI')
	show "vfsequence (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>')" unfolding RK_\<sigma>23_def by simp
	show "vcard (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>') = 5\<^sub>\<nat>"
	unfolding RK_\<sigma>23_def by (simp_all add: nat_omega_simps)
	show "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> RK23 \<TT>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>" for a
	proof-
	from that consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> \| \<open>a = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_cs_simps three by auto
	from this 0123 show ?thesis
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
	cs_intro:
	cat_cs_intros
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	nat_omega_intros
	)+
	qed
	show
	"RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	RK23 \<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b" for a b f
	using that 0123
	by (elim cat_ordinal_3_is_arrE, use nothing in \<open>simp_all only:\<close>) (slow)
	(
	cs_concl
	cs_simp:
	cat_cs_simps
	cat_ordinal_cs_simps
	\<FF>'.cf_ArrMap_Comp[symmetric]
	\<FF>'.HomCod.cat_Comp_assoc
	\<epsilon>'.ntcf_Comp_commute[symmetric]
	cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
	)+
	qed
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma RK_\<sigma>23_is_ntcf'[cat_Kan_cs_intros]:
	assumes "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<epsilon>' : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<GG>' = \<FF>'"
	and "\<HH>' = RK23 \<TT>"
	and "\<CC>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>': \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1-3) unfolding assms(4-6) by (rule RK_\<sigma>23_is_ntcf)



	subsection\<open>The right Kan extension along \<open>\<KK>23\<close>\<close>

	lemma \<epsilon>23_is_cat_rKe:
	assumes "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "ntcf_id \<TT> :
	RK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C \<AA>"
	proof-

	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(1))
	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret RK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>RK23 \<TT>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	from 0123 have [cat_cs_simps]: "\<TT>\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> = \<AA>\<lparr>CId\<rparr>\<lparr>\<TT>\<lparr>ObjMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
	cs_intro: cat_cs_intros
	)

	show ?thesis
	proof(intro is_cat_rKeI')

	fix \<FF>' \<epsilon>' assume prems:
	"\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<epsilon>' : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"

	interpret \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule prems(1))
	interpret \<epsilon>': is_ntcf \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close> \<TT> \<epsilon>'
	by (rule prems(2))
	interpret RK_\<sigma>23: is_ntcf \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' \<open>RK23 \<TT>\<close> \<open>RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<close>
	by (intro RK_\<sigma>23_is_ntcf prems assms)

	show "\<exists>!\<sigma>.
	\<sigma> : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and>
	\<epsilon>' = ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"
	proof(intro ex1I conjI; (elim conjE)?)
	show "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro RK_\<sigma>23.is_ntcf_axioms)
	show "\<epsilon>' = ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"
	proof(rule ntcf_eqI)
	show "\<epsilon>' : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro prems)
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<epsilon>'\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show rhs:
	"ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23) :
	\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F \<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show "\<epsilon>'\<lparr>NTMap\<rparr> = (ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> unfolding two by auto
	then show
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	(ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	omega_of_set
	cat_Kan_cs_simps
	cat_cs_simps
	cat_ordinal_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
	)+
	qed
	(
	use rhs in
	\<open>cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros\<close>
	)+
	qed simp_all

	fix \<sigma> assume prems':
	"\<sigma> : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<epsilon>' = ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"

	interpret \<sigma>: is_ntcf \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' \<open>RK23 \<TT>\<close> \<sigma>
	by (rule prems'(1))

	from prems'(2) have
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = (ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by auto
	then have [cat_cs_simps]: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)
	from prems'(2) have
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = (ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by auto
	then have [cat_cs_simps]: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp:
	omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)

	show "\<sigma> = RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'"
	proof(rule ntcf_eqI)
	show "\<sigma> : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule prems'(1))
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	show "RK_\<sigma>23 \<TT> \<epsilon>' \<FF>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> (RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	from 0123 have 013: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by (cs_concl cs_intro: cat_ordinal_cs_intros nat_omega_intros)
	from 0123 have 123: "[1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> : 1\<^sub>\<nat> \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 2\<^sub>\<nat>"
	by (cs_concl cs_intro: cat_ordinal_cs_intros nat_omega_intros)

	from \<sigma>.ntcf_Comp_commute[OF 123] 013 0123
	have [symmetric, cat_Kan_cs_simps]:
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<FF>'\<lparr>ArrMap\<rparr> \<lparr>1\<^sub>\<nat>, 2\<^sub>\<nat>\<rparr>\<^sub>\<bullet> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_Kan_cs_simps RK23_ArrMap_app_12
	cs_intro: cat_cs_intros
	)
	show "\<sigma>\<lparr>NTMap\<rparr> = RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> \| \<open>a = 2\<^sub>\<nat>\<close> unfolding three by auto
	then show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = RK_\<sigma>23 \<TT> \<epsilon>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(cs_concl cs_simp: cat_cs_simps cat_Kan_cs_simps)+
	qed auto
	qed simp_all

	qed

	qed (cs_concl cs_shallow cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

	qed



	subsection\<open>
	\<open>LK_\<sigma>23\<close>: towards the universal property of the left Kan extension along \<open>\<KK>23\<close>
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition LK_\<sigma>23 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "LK_\<sigma>23 \<TT> \<eta>' \<FF>' =
	[
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub> \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	),
	LK23 \<TT>,
	\<FF>',
	cat_ordinal (3\<^sub>\<nat>),
	\<FF>'\<lparr>HomCod\<rparr>
	]\<^sub>\<circ>"


	text\<open>Components.\<close>

	lemma LK_\<sigma>23_components:
	shows "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr> =
	(
	\<lambda>a\<in>\<^sub>\<circ>cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>.
	if a = 0 \<Rightarrow> \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 1\<^sub>\<nat> \<Rightarrow> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub> \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>
	\| a = 2\<^sub>\<nat> \<Rightarrow> \<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
	\| otherwise \<Rightarrow> \<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>
	)"
	and "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTDom\<rparr> = LK23 \<TT>"
	and "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTCod\<rparr> = \<FF>'"
	and "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTDGDom\<rparr> = cat_ordinal (3\<^sub>\<nat>)"
	and "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTDGCod\<rparr> = \<FF>'\<lparr>HomCod\<rparr>"
	unfolding LK_\<sigma>23_def nt_field_simps by (simp_all add: nat_omega_simps)

	context
	fixes \<alpha> \<AA> \<FF>' \<TT>
	assumes \<FF>': "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and \<TT>: "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	begin

	interpretation \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule \<FF>')
	interpretation \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule \<TT>)

	lemmas LK_\<sigma>23_components' =
	LK_\<sigma>23_components[where \<FF>'=\<FF>' and \<TT>=\<TT>, unfolded cat_cs_simps]

	lemmas [cat_Kan_cs_simps] = LK_\<sigma>23_components'(2-5)

	end


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda LK_\<sigma>23_components(1)
	\|vsv LK_\<sigma>23_NTMap_vsv[cat_Kan_cs_intros]\|
	\|vdomain LK_\<sigma>23_NTMap_vdomain[cat_Kan_cs_simps]\|
	\|app LK_\<sigma>23_NTMap_app\|

	lemma LK_\<sigma>23_NTMap_app_0[cat_Kan_cs_simps]:
	assumes "a = 0"
	shows "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	using assms unfolding LK_\<sigma>23_components cat_ordinal_cs_simps by simp

	lemma (in is_functor) LK_\<sigma>23_NTMap_app_1[cat_Kan_cs_simps]:
	assumes "a = 1\<^sub>\<nat>"
	shows "LK_\<sigma>23 \<FF> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<FF>'\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	using assms unfolding LK_\<sigma>23_components cat_ordinal_cs_simps cat_cs_simps by simp

	lemmas [cat_Kan_cs_simps] = is_functor.LK_\<sigma>23_NTMap_app_1

	lemma LK_\<sigma>23_NTMap_app_2[cat_Kan_cs_simps]:
	assumes "a = 2\<^sub>\<nat>"
	shows "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	using assms unfolding LK_\<sigma>23_components cat_ordinal_cs_simps by simp


	subsubsection\<open>\<open>LK_\<sigma>23\<close> is a natural transformation\<close>

	lemma LK_\<sigma>23_is_ntcf:
	assumes "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "LK_\<sigma>23 \<TT> \<eta>' \<FF>' : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	proof-

	interpret \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule assms(1))
	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(2))
	interpret \<eta>': is_ntcf \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close> \<eta>'
	by (rule assms(3))

	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret LK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>LK23 \<TT>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	show ?thesis
	proof(rule is_ntcfI')
	show "vfsequence (LK_\<sigma>23 \<TT> \<eta>' \<FF>')" unfolding LK_\<sigma>23_def by simp
	show "vcard (LK_\<sigma>23 \<TT> \<eta>' \<FF>') = 5\<^sub>\<nat>"
	unfolding LK_\<sigma>23_def by (simp_all add: nat_omega_simps)
	show "LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : LK23 \<TT>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Obj\<rparr>" for a
	proof-
	from that consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> \| \<open>a = 2\<^sub>\<nat>\<close>
	unfolding cat_ordinal_cs_simps three by auto
	from this 0123 show
	"LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : LK23 \<TT>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
	cs_intro:
	cat_cs_intros
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	nat_omega_intros
	)+
	qed
	show
	"LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> LK23 \<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b" for a b f
	- using that 0123
	- by (elim cat_ordinal_3_is_arrE, use nothing in \<open>simp_all only:\<close>) (slow)
	+ using that 0123 (very slow)
	+ by (elim cat_ordinal_3_is_arrE, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	- cs_simp:
	- cat_cs_simps
	+ cs_simp:
	+ cat_cs_simps
	cat_ordinal_cs_simps
	\<FF>'.cf_ArrMap_Comp[symmetric]
	\<FF>'.HomCod.cat_Comp_assoc[symmetric]
	- \<eta>'.ntcf_Comp_commute
	- cat_Kan_cs_simps
	+ \<eta>'.ntcf_Comp_commute
	+ cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
	)+
	qed
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
	)+

	qed

	lemma LK_\<sigma>23_is_ntcf'[cat_Kan_cs_intros]:
	assumes "\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	and "\<GG>' = LK23 \<TT>"
	and "\<HH>' = \<FF>'"
	and "\<CC>' = cat_ordinal (3\<^sub>\<nat>)"
	shows "LK_\<sigma>23 \<TT> \<eta>' \<FF>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>': \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	using assms(1-3) unfolding assms(4-6) by (rule LK_\<sigma>23_is_ntcf)



	subsection\<open>The left Kan extension along \<open>\<KK>23\<close>\<close>

	lemma \<eta>23_is_cat_rKe:
	assumes "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "ntcf_id \<TT> :
	\<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> LK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C \<AA>"
	proof-

	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(1))
	interpret \<KK>23: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>\<KK>23\<close>
	by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_Kan_cs_intros)
	interpret LK23: is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>LK23 \<TT>\<close>
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)

	show ?thesis
	proof(intro is_cat_lKeI')
	fix \<FF>' \<eta>' assume prems:
	"\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"

	interpret \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<FF>' by (rule prems(1))
	interpret \<eta>': is_ntcf \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close> \<eta>'
	by (rule prems(2))
	interpret LK_\<sigma>23: is_ntcf \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>LK23 \<TT>\<close> \<FF>' \<open>LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<close>
	by (intro LK_\<sigma>23_is_ntcf prems assms)

	show "\<exists>!\<sigma>.
	\<sigma> : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and>
	\<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>"
	proof(intro ex1I conjI; (elim conjE)?)
	show "LK_\<sigma>23 \<TT> \<eta>' \<FF>' : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro LK_\<sigma>23.is_ntcf_axioms)
	show "\<eta>' = LK_\<sigma>23 \<TT> \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>"
	proof(rule ntcf_eqI)
	show "\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (intro prems)
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<eta>'\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show rhs:
	"LK_\<sigma>23 \<TT> \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> :
	\<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((LK_\<sigma>23 \<TT> \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show "\<eta>'\<lparr>NTMap\<rparr> = (LK_\<sigma>23 \<TT> \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> unfolding two by auto
	then show
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	(LK_\<sigma>23 \<TT> \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	omega_of_set
	cat_Kan_cs_simps
	cat_cs_simps
	cat_ordinal_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
	)+
	qed
	(
	use rhs in
	\<open>cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros\<close>
	)+
	qed simp_all

	fix \<sigma> assume prems':
	"\<sigma> : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	"\<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>"

	interpret \<sigma>: is_ntcf \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<AA> \<open>LK23 \<TT>\<close> \<FF>' \<sigma>
	by (rule prems'(1))

	from prems'(2) have
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by auto
	then have [cat_cs_simps]: "\<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)
	from prems'(2) have
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by auto
	then have [cat_cs_simps]: "\<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp:
	omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
	cs_intro: cat_cs_intros nat_omega_intros
	)

	show "\<sigma> = LK_\<sigma>23 \<TT> \<eta>' \<FF>'"
	proof(rule ntcf_eqI)

	show "\<sigma> : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (rule prems'(1))
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	show "LK_\<sigma>23 \<TT> \<eta>' \<FF>' : LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
	then have dom_rhs: "\<D>\<^sub>\<circ> (LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_ordinal_cs_simps)
	from 0123 have 012: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by (cs_concl cs_intro: cat_ordinal_cs_intros nat_omega_intros)
	from 0123 have 013: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by (cs_concl cs_intro: cat_ordinal_cs_intros nat_omega_intros)
	from 0123 have 00: "[0, 0]\<^sub>\<circ> = (cat_ordinal (2\<^sub>\<nat>))\<lparr>CId\<rparr>\<lparr>0\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps)
	from \<sigma>.ntcf_Comp_commute[OF 013] 013 0123
	have [symmetric, cat_Kan_cs_simps]:
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<FF>'\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by
	(
	cs_prems
	cs_simp: cat_cs_simps cat_Kan_cs_simps 00 LK23_ArrMap_app_01
	cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
	)

	show "\<sigma>\<lparr>NTMap\<rparr> = LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix a assume prems: "a \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>a = 0\<close> \| \<open>a = 1\<^sub>\<nat>\<close> \| \<open>a = 2\<^sub>\<nat>\<close> unfolding three by auto
	then show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = LK_\<sigma>23 \<TT> \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros
	)+
	qed auto
	qed simp_all

	qed

	qed (cs_concl cs_shallow cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

	qed



	subsection\<open>Pointwise Kan extensions along \<open>\<KK>23\<close>\<close>

	lemma \<epsilon>23_is_cat_pw_rKe:
	assumes "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "ntcf_id \<TT> :
	RK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C \<AA>"
	proof-

	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(1))

	show ?thesis
	proof(intro is_cat_pw_rKeI \<epsilon>23_is_cat_rKe[OF assms])

	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"

	show
	"ntcf_id \<TT> :
	RK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) : \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
	proof(intro is_cat_rKe_preservesI \<epsilon>23_is_cat_rKe[OF assms])
	from prems show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> :
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>) \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C cat_Set \<alpha>"
	proof(intro is_cat_rKeI')
	show "\<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_ordinal (3\<^sub>\<nat>)"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	from prems show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
	from prems show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)

	fix \<GG>' \<epsilon>' assume prems':
	"\<GG>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	"\<epsilon>' :
	\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"

	interpret \<GG>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>cat_Set \<alpha>\<close> \<GG>'
	by (rule prems'(1))
	interpret \<epsilon>': is_ntcf
	\<alpha>
	\<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	\<open>cat_Set \<alpha>\<close>
	\<open>\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close>
	\<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>\<close>
	\<epsilon>'
	by (rule prems'(2))

	show "\<exists>!\<sigma>.
	\<sigma> :
	\<GG>' \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha> \<and>
	\<epsilon>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"
	proof(intro ex1I conjI; (elim conjE)?)
	have [cat_Kan_cs_simps]:
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> = RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)"
	proof(rule cf_eqI)
	from prems show lhs: "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)
	from prems show rhs: "RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros
	)
	from lhs prems have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ObjMap\<rparr>) = 3\<^sub>\<nat>"
	by
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	from rhs prems have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>))\<lparr>ObjMap\<rparr>) = 3\<^sub>\<nat>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros
	)
	show
	"(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ObjMap\<rparr> =
	RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix c assume prems'': "c \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	with 0123 consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close> by force
	from this prems prems'' 0123 show
	"(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> =
	RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_cs_simps
	cat_op_simps
	cat_Kan_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)+
	qed
	(
	use prems in \<open>
	cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros
	\<close>
	)+
	from lhs prems have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ArrMap\<rparr>) =
	cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	from rhs prems have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> ((RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>))\<lparr>ArrMap\<rparr>) =
	cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	cs_intro: cat_Kan_cs_intros
	)
	show
	"(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ArrMap\<rparr> =
	RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume prems'': "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	then obtain a' b' where "f : a' \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b'" by auto
	from this 0123 prems show
	"(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	RK23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (slow)
	(
	elim cat_ordinal_3_is_arrE;
	use nothing in \<open>simp_all only:\<close>
	)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
	cs_intro:
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	nat_omega_intros
	)+
	qed
	(
	use prems in
	\<open>cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros\<close>
	)+
	qed simp_all

	show "RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' :
	\<GG>' \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (intro RK_\<sigma>23_is_ntcf')
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros
	)+
	show "\<epsilon>' =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"
	proof(rule ntcf_eqI)
	show "\<epsilon>' :
	\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (intro prems')
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<epsilon>'\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	from prems show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23) :
	\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>23 \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ>
	(
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)
	)\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show "\<epsilon>'\<lparr>NTMap\<rparr> =
	(
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)
	)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix c assume prems'': "c \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> unfolding two by auto
	from this prems 0123 show "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	(
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)
	)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_Kan_cs_simps
	cat_ordinal_cs_simps
	cat_cs_simps
	cat_op_simps
	RK_\<sigma>23_NTMap_app_0
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)+
	qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)+

	qed simp_all

	fix \<sigma> assume prems'':
	"\<sigma> :
	\<GG>' \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	"\<epsilon>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)"

	interpret \<sigma>: is_ntcf
	\<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>cat_Set \<alpha>\<close> \<GG>' \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT>\<close> \<sigma>
	by (rule prems''(1))

	from prems''(2) have "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> =
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23))\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by auto
	from this prems 0123 have \<epsilon>'_NTMap_app_0: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by
	(
	cs_prems
	cs_simp:
	cat_ordinal_cs_simps
	cat_cs_simps
	cat_Kan_cs_simps
	cat_op_simps
	\<KK>23_ObjMap_app_0
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)
	from 0123 have 01: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_ordinal_cs_intros nat_omega_intros
	)
	from prems''(2) have
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> =
	(
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23)
	)\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by auto
	from this prems 0123 have \<epsilon>'_NTMap_app_1:
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>"
	by
	(
	cs_prems
	cs_simp:
	cat_ordinal_cs_simps
	cat_cs_simps
	cat_Kan_cs_simps
	cat_op_simps
	\<KK>23_ObjMap_app_1
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)

	from 0123 have 012: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by
	(
	cs_concl cs_intro:
	cat_ordinal_cs_intros nat_omega_intros
	)
	from 0123 have 013: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by
	(
	cs_concl cs_intro:
	cat_ordinal_cs_intros nat_omega_intros
	)
	from 0123 have 123: "[1\<^sub>\<nat>, 2\<^sub>\<nat>]\<^sub>\<circ> : 1\<^sub>\<nat> \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 2\<^sub>\<nat>"
	by
	(
	cs_concl cs_intro:
	cat_ordinal_cs_intros nat_omega_intros
	)
	from 0123 have 11: "[1\<^sub>\<nat>, 1\<^sub>\<nat>]\<^sub>\<circ> = (cat_ordinal (2\<^sub>\<nat>))\<lparr>CId\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps)

	from \<sigma>.ntcf_Comp_commute[OF 123] prems 012 013
	have [cat_Kan_cs_simps]:
	"\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<GG>'\<lparr>ArrMap\<rparr>\<lparr>1\<^sub>\<nat>, 2\<^sub>\<nat>\<rparr>\<^sub>\<bullet> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by (slow)
	(
	cs_prems
	cs_simp:
	cat_cs_simps
	cat_Kan_cs_simps
	\<epsilon>'_NTMap_app_1[symmetric]
	is_functor.cf_ObjMap_CId
	RK23_ArrMap_app_12
	11
	cs_intro: cat_cs_intros nat_omega_intros
	)

	show "\<sigma> = RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>'"
	proof(rule ntcf_eqI)

	show \<sigma>: "\<sigma> :
	\<GG>' \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule prems''(1))
	then have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show "RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>' :
	\<GG>' \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F RK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> (RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>'\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show "\<sigma>\<lparr>NTMap\<rparr> = RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>'\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix c assume "c \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close>
	unfolding three by auto
	from this 0123 show
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = RK_\<sigma>23 (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>) \<epsilon>' \<GG>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl cs_simp:
	cat_Kan_cs_simps \<epsilon>'_NTMap_app_1 \<epsilon>'_NTMap_app_0
	)+
	qed (cs_concl cs_intro: cat_Kan_cs_intros V_cs_intros)+

	qed simp_all

	qed

	qed

	qed

	qed

	qed

	lemma \<eta>23_is_cat_pw_lKe:
	assumes "\<TT> : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
	shows "ntcf_id \<TT> :
	\<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> LK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C \<AA>"
	proof-

	interpret \<TT>: is_functor \<alpha> \<open>cat_ordinal (2\<^sub>\<nat>)\<close> \<AA> \<TT> by (rule assms(1))

	from ord_of_nat_\<omega> interpret cat_ordinal_3: finite_category \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close>
	by (cs_concl cs_shallow cs_intro: cat_ordinal_cs_intros)

	from 0123 have 002: "[0, 0]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (2\<^sub>\<nat>)\<^esub> 0"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps cs_intro: cat_cs_intros
	)

	show ?thesis
	proof(intro is_cat_pw_lKeI \<eta>23_is_cat_rKe assms, unfold cat_op_simps)
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	show
	"op_ntcf (ntcf_id \<TT>) :
	op_cf (LK23 \<TT>) \<circ>\<^sub>C\<^sub>F op_cf \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat (cat_ordinal (2\<^sub>\<nat>)) \<mapsto>\<^sub>C op_cat (cat_ordinal (3\<^sub>\<nat>)) \<mapsto>\<^sub>C
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
	proof(intro is_cat_rKe_preservesI)
	show
	"op_ntcf (ntcf_id \<TT>) :
	op_cf (LK23 \<TT>) \<circ>\<^sub>C\<^sub>F op_cf \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
	op_cat (cat_ordinal (2\<^sub>\<nat>)) \<mapsto>\<^sub>C op_cat (cat_ordinal (3\<^sub>\<nat>)) \<mapsto>\<^sub>C op_cat \<AA>"
	proof(cs_intro_step cat_op_intros)
	show "ntcf_id \<TT> :
	\<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> LK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C \<AA>"
	by (intro \<eta>23_is_cat_rKe assms)
	qed simp_all
	from prems show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)

	have
	"op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub>
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>) \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<^sub>C cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<^sub>C op_cat (cat_Set \<alpha>)"
	proof(intro is_cat_lKeI')
	show "\<KK>23 : cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_ordinal (3\<^sub>\<nat>)"
	by (cs_concl cs_shallow cs_intro: cat_Kan_cs_intros)
	from prems show "op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)

	from prems show
	"op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT> :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)

	fix \<FF>' \<eta>' assume prems':
	"\<FF>' : cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	"\<eta>' :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"

	interpret \<FF>': is_functor \<alpha> \<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>op_cat (cat_Set \<alpha>)\<close> \<FF>'
	by (rule prems'(1))
	interpret \<eta>': is_ntcf
	\<alpha>
	\<open>cat_ordinal (2\<^sub>\<nat>)\<close>
	\<open>op_cat (cat_Set \<alpha>)\<close>
	\<open>op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>\<close>
	\<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23\<close>
	\<eta>'
	by (rule prems'(2))
	note [unfolded cat_op_simps, cat_cs_intros] =
	\<eta>'.ntcf_NTMap_is_arr'
	\<FF>'.cf_ArrMap_is_arr'
	show
	"\<exists>!\<sigma>.
	\<sigma> :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>) \<and>
	\<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)"
	proof(intro ex1I conjI; (elim conjE)?)
	have [cat_Kan_cs_simps]:
	"op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> =
	LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)"
	proof(rule cf_eqI)
	from prems show lhs: "op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl
	cs_simp: cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)
	from prems show rhs: "LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)
	from lhs prems have ObjMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ObjMap\<rparr>) = 3\<^sub>\<nat>"
	by
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	from rhs prems have ObjMap_dom_rhs:
	"\<D>\<^sub>\<circ> (LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>) = 3\<^sub>\<nat>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	)
	show
	"(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ObjMap\<rparr> =
	LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>"
	proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
	fix c assume prems'': "c \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close>
	unfolding three by auto
	from this prems 0123 show
	"(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> =
	LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	by (cases; use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	cat_cs_simps
	cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)+
	qed
	(
	use prems in
	\<open>
	cs_concl
	cs_simp: cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	\<close>
	)+

	from lhs prems have ArrMap_dom_lhs:
	"\<D>\<^sub>\<circ> ((op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ArrMap\<rparr>) =
	cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	from rhs prems have ArrMap_dom_rhs:
	"\<D>\<^sub>\<circ> (LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>) =
	cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show
	"(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ArrMap\<rparr> =
	LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>"
	proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
	fix f assume "f \<in>\<^sub>\<circ> cat_ordinal (3\<^sub>\<nat>)\<lparr>Arr\<rparr>"
	then obtain a' b' where f: "f : a' \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> b'"
	by auto
	from f prems 0123 002 show
	"(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	LK23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
	by (elim cat_ordinal_3_is_arrE, (simp_all only:)?)
	(
	cs_concl
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
	cs_intro:
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	cat_op_intros
	nat_omega_intros
	)+
	qed
	(
	use prems in
	\<open>
	cs_concl
	cs_simp: cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros\<close>
	)+

	qed simp_all

	show "LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)

	show "\<eta>' =
	LK_\<sigma>23
	(
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>
	)"
	proof(rule ntcf_eqI)
	show lhs: "\<eta>' :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by (rule prems'(2))
	from lhs have "\<D>\<^sub>\<circ> (\<eta>'\<lparr>NTMap\<rparr>) = cat_ordinal (2\<^sub>\<nat>)\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from prems show rhs:
	"LK_\<sigma>23
	(
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>
	) :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>23 :
	cat_ordinal (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl
	cs_simp: cat_Kan_cs_simps cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)
	from lhs have dom_lhs: "\<D>\<^sub>\<circ> (\<eta>'\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_ordinal_cs_simps cat_cs_simps
	)
	from rhs have dom_rhs: "\<D>\<^sub>\<circ> ((LK_\<sigma>23
	(
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>
	))\<lparr>NTMap\<rparr>) = 2\<^sub>\<nat>"
	by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	show
	"\<eta>'\<lparr>NTMap\<rparr> =
	(
	LK_\<sigma>23
	(
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>
	)
	)\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_ordinal_cs_simps)
	fix c assume "c \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
	then consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> unfolding two by auto
	from this prems 0123 show
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	(
	LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)
	)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	cat_cs_simps
	cat_op_simps
	\<KK>23_ObjMap_app_1
	\<KK>23_ObjMap_app_0
	LK_\<sigma>23_NTMap_app_0
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)+
	- qed (cs_concl cs_shallow cs_intro: V_cs_intros cat_cs_intros)+
	+ qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
	qed simp_all

	fix \<sigma> assume prems'':
	"\<sigma> :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	"\<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)"

	interpret \<sigma>: is_ntcf
	\<alpha>
	\<open>cat_ordinal (3\<^sub>\<nat>)\<close> \<open>op_cat (cat_Set \<alpha>)\<close>
	\<open>op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT>\<close>
	\<FF>'
	\<sigma>
	by (rule prems''(1))

	note [cat_Kan_cs_intros] = \<sigma>.ntcf_NTMap_is_arr'[unfolded cat_op_simps]

	from prems''(2) have
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> =
	(
	\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)
	)\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by simp
	from this prems 0123 have \<eta>'_NTMap_app_0: "\<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>0\<rparr>"
	by (very slow)
	(
	cs_prems
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	cat_cs_simps
	cat_op_simps
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)

	from prems''(2) have
	"\<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> =
	(
	\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
	\<KK>23 \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	(op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<TT>)
	)\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>"
	by simp
	from this prems 0123 have \<eta>'_NTMap_app_1: "\<eta>'\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>"
	by (very slow)
	(
	cs_prems
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	cat_cs_simps
	cat_op_simps
	cat_Set_components(1)
	cs_intro:
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	\<TT>.HomCod.cat_Hom_in_Vset
	)+

	from 0123 have 013: "[0, 1\<^sub>\<nat>]\<^sub>\<circ> : 0 \<mapsto>\<^bsub>cat_ordinal (3\<^sub>\<nat>)\<^esub> 1\<^sub>\<nat>"
	by (cs_concl cs_intro: cat_ordinal_cs_intros nat_omega_intros)
	from 0123 have 00: "[0, 0]\<^sub>\<circ> = (cat_ordinal (2\<^sub>\<nat>))\<lparr>CId\<rparr>\<lparr>0\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps)

	from \<sigma>.ntcf_Comp_commute[OF 013] prems 0123 013
	have [cat_Kan_cs_simps]:
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> = \<eta>'\<lparr>NTMap\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<FF>'\<lparr>ArrMap\<rparr>\<lparr>0, 1\<^sub>\<nat>\<rparr>\<^sub>\<bullet>"
	by
	(
	cs_prems
	cs_simp:
	cat_ordinal_cs_simps
	cat_Kan_cs_simps
	cat_cs_simps
	cat_op_simps
	LK23_ArrMap_app_01
	cs_intro:
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	cat_prod_cs_intros
	cat_op_intros
	nat_omega_intros
	cs_simp: 00 \<eta>'_NTMap_app_0[symmetric]
	)

	show "\<sigma> = LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>'"
	proof(rule ntcf_eqI)
	show lhs: "\<sigma> :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by (rule prems''(1))
	show rhs: "LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>' :
	op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F LK23 \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' :
	cat_ordinal (3\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_Kan_cs_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros
	)
	from lhs have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)
	from rhs have dom_rhs:
	"\<D>\<^sub>\<circ> (LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>'\<lparr>NTMap\<rparr>) = 3\<^sub>\<nat>"
	by (cs_concl cs_shallow cs_simp: cat_ordinal_cs_simps cat_cs_simps)

	show "\<sigma>\<lparr>NTMap\<rparr> = LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>'\<lparr>NTMap\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	fix c assume "c \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
	then consider \<open>c = 0\<close> \| \<open>c = 1\<^sub>\<nat>\<close> \| \<open>c = 2\<^sub>\<nat>\<close>
	unfolding three by auto
	from this 0123 show
	"\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
	LK_\<sigma>23 (op_cf Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F \<TT>) \<eta>' \<FF>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
	by (cases, use nothing in \<open>simp_all only:\<close>)
	(
	cs_concl
	cs_simp:
	cat_ordinal_cs_simps
	cat_cs_simps
	cat_Kan_cs_simps
	cat_op_simps
	\<eta>'_NTMap_app_0
	LK_\<sigma>23_NTMap_app_0
	\<eta>'_NTMap_app_1
	cs_intro:
	cat_ordinal_cs_intros
	cat_Kan_cs_intros
	cat_cs_intros
	cat_op_intros
	nat_omega_intros
	)+
	qed (cs_concl cs_intro: cat_Kan_cs_intros V_cs_intros)+

	qed simp_all

	qed

	qed

	then have
	"op_ntcf (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_id \<TT>)) :
	op_cf (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<TT>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub>
	op_cf ((Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F op_cf (LK23 \<TT>))) \<circ>\<^sub>C\<^sub>F op_cf (op_cf \<KK>23) :
	op_cat (op_cat (cat_ordinal (2\<^sub>\<nat>))) \<mapsto>\<^sub>C
	op_cat (op_cat (cat_ordinal (3\<^sub>\<nat>))) \<mapsto>\<^sub>C
	op_cat (cat_Set \<alpha>)"
	by
	(
	cs_concl
	cs_simp: cat_op_simps
	cs_intro: cat_cs_intros cat_Kan_cs_intros cat_op_intros
	)
	from is_cat_lKe.is_cat_rKe_op[OF this] prems show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_id \<TT>) :
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F op_cf (LK23 \<TT>)) \<circ>\<^sub>C\<^sub>F op_cf \<KK>23 \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub>
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<TT> :
	op_cat (cat_ordinal (2\<^sub>\<nat>)) \<mapsto>\<^sub>C
	op_cat (cat_ordinal (3\<^sub>\<nat>)) \<mapsto>\<^sub>C
	cat_Set \<alpha>"
	by
	(
	cs_prems
	cs_simp: cat_op_simps
	cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
	)

	qed

	qed

	qed

	text\<open>\newpage\<close>

	end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Pointed.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Pointed.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Pointed.thy
	@@ -0,0 +1,748 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Pointed arrows and natural transformations\<close>
	+theory CZH_UCAT_Pointed
	+ imports
	+ CZH_Elementary_Categories.CZH_ECAT_NTCF
	+ CZH_Elementary_Categories.CZH_ECAT_Hom
	+begin
	+
	+
	+
	+subsection\<open>Pointed arrow\<close>
	+
	+
	+text\<open>
	+The terminology that is used in this section deviates from convention: a
	+pointed arrow is merely an arrow in \<open>Set\<close> from a singleton set to another set.
	+\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+
	+definition ntcf_paa :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_paa \<aa> B b = [(\<lambda>a\<in>\<^sub>\<circ>set {\<aa>}. b), set {\<aa>}, B]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_paa_components:
	+ shows "ntcf_paa \<aa> B b\<lparr>ArrVal\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>set {\<aa>}. b)"
	+ and [cat_cs_simps]: "ntcf_paa \<aa> B b\<lparr>ArrDom\<rparr> = set {\<aa>}"
	+ and [cat_cs_simps]: "ntcf_paa \<aa> B b\<lparr>ArrCod\<rparr> = B"
	+ unfolding ntcf_paa_def arr_field_simps by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Arrow value\<close>
	+
	+mk_VLambda ntcf_paa_components(1)
	+ \|vsv ntcf_paa_ArrVal_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_paa_ArrVal_vdomain[cat_cs_simps]\|
	+ \|app ntcf_paa_ArrVal_app[unfolded vsingleton_iff, cat_cs_simps]\|
	+
	+
	+subsubsection\<open>Pointed arrow is an arrow in \<open>Set\<close>\<close>
	+
	+lemma (in \<Z>) ntcf_paa_is_arr:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "a \<in>\<^sub>\<circ> A"
	+ shows "ntcf_paa \<aa> A a : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> A"
	+proof(intro cat_Set_is_arrI arr_SetI cat_cs_intros, unfold cat_cs_simps)
	+ show "vfsequence (ntcf_paa \<aa> A a)" unfolding ntcf_paa_def by simp
	+ show "vcard (ntcf_paa \<aa> A a) = 3\<^sub>\<nat>"
	+ unfolding ntcf_paa_def by (simp add: nat_omega_simps)
	+ show "\<R>\<^sub>\<circ> (ntcf_paa \<aa> A a\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> A"
	+ unfolding ntcf_paa_components by (intro vrange_VLambda_vsubset assms)
	+qed (use assms in \<open>auto simp: cat_Set_components(1) Limit_vsingleton_in_VsetI\<close>)
	+
	+lemma (in \<Z>) ntcf_paa_is_arr'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "A \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "a \<in>\<^sub>\<circ> A"
	+ and "A' = set {\<aa>}"
	+ and "B' = A"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "ntcf_paa \<aa> A a : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1-3) unfolding assms(4-6) by (rule ntcf_paa_is_arr)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_paa_is_arr'
	+
	+
	+subsubsection\<open>Further properties\<close>
	+
	+lemma ntcf_paa_injective[cat_cs_simps]:
	+ "ntcf_paa \<aa> A b = ntcf_paa \<aa> A c \<longleftrightarrow> b = c"
	+proof
	+ assume "ntcf_paa \<aa> A b = ntcf_paa \<aa> A c"
	+ then have "ntcf_paa \<aa> A b\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> = ntcf_paa \<aa> A c\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>" by simp
	+ then show "b = c" by (cs_prems cs_simp: cat_cs_simps)
	+qed simp
	+
	+lemma (in \<Z>) ntcf_paa_ArrVal:
	+ assumes "F : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ shows "ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>) = F"
	+proof-
	+ interpret F: arr_Set \<alpha> F
	+ rewrites [cat_cs_simps]: "F\<lparr>ArrDom\<rparr> = set {\<aa>}"
	+ and [cat_cs_simps]: "F\<lparr>ArrCod\<rparr> = X"
	+ by (auto simp: cat_Set_is_arrD[OF assms])
	+ from F.arr_Par_ArrDom_in_Vset have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ from assms \<aa> F.arr_Par_ArrCod_in_Vset have lhs_is_arr:
	+ "ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>) : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_Set_components(1)
	+ cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ )
	+ then have dom_lhs: "\<D>\<^sub>\<circ> (ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from assms have dom_rhs: "\<D>\<^sub>\<circ> (F\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ show ?thesis
	+ proof(rule arr_Set_eqI)
	+ from lhs_is_arr assms
	+ show arr_Set_lhs: "arr_Set \<alpha> (ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>))"
	+ and arr_Set_rhs: "arr_Set \<alpha> F"
	+ by (auto dest: cat_Set_is_arrD)
	+ show "ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrVal\<rparr> = F\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs vsingleton_iff; (simp only:)?)
	+ show "ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use arr_Set_lhs arr_Set_rhs in auto)
	+ qed (use assms in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+qed
	+
	+lemma (in \<Z>) ntcf_paa_ArrVal'(not cat_cs_simps):
	+ assumes "F : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X" and "a = \<aa>"
	+ shows "ntcf_paa \<aa> X (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) = F"
	+ using assms(1) unfolding assms(2) by (rule ntcf_paa_ArrVal)
	+
	+lemma (in \<Z>) ntcf_paa_Comp_right[cat_cs_simps]:
	+ assumes "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ and "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "a \<in>\<^sub>\<circ> A"
	+ shows "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a = ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)"
	+proof-
	+ from assms have F_paa:
	+ "F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a)\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from assms have paa: "ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B"
	+ by (cs_concl cs_shallow cs_intro: cat_Set_cs_intros cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> ((ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>))\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ show ?thesis
	+ proof(rule arr_Set_eqI)
	+ from F_paa paa assms
	+ show arr_Set_lhs: "arr_Set \<alpha> (F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a)"
	+ and arr_Set_rhs: "arr_Set \<alpha> (ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>))"
	+ by (auto dest: cat_Set_is_arrD)
	+ show
	+ "(F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a)\<lparr>ArrVal\<rparr> =
	+ ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs vsingleton_iff; (simp only:)?)
	+ from assms show
	+ "(F \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_paa \<aa> A a)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> =
	+ ntcf_paa \<aa> B (F\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
	+ qed (use arr_Set_lhs arr_Set_rhs in auto)
	+ qed (use F_paa paa in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+qed
	+
	+lemmas [cat_cs_simps] = \<Z>.ntcf_paa_Comp_right
	+
	+
	+
	+subsection\<open>Pointed natural transformation\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+
	+definition ntcf_pointed :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_pointed \<alpha> \<aa> =
	+ [
	+ (
	+ \<lambda>x\<in>\<^sub>\<circ>cat_Set \<alpha>\<lparr>Obj\<rparr>.
	+ [
	+ (\<lambda>f\<in>\<^sub>\<circ>Hom (cat_Set \<alpha>) (set {\<aa>}) x. f\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>),
	+ Hom (cat_Set \<alpha>) (set {\<aa>}) x,
	+ x
	+ ]\<^sub>\<circ>
	+ ),
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-),
	+ cf_id (cat_Set \<alpha>),
	+ cat_Set \<alpha>,
	+ cat_Set \<alpha>
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_pointed_components:
	+ shows "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr> =
	+ (
	+ \<lambda>x\<in>\<^sub>\<circ>cat_Set \<alpha>\<lparr>Obj\<rparr>.
	+ [
	+ (\<lambda>f\<in>\<^sub>\<circ>Hom (cat_Set \<alpha>) (set {\<aa>}) x. f\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>),
	+ Hom (cat_Set \<alpha>) (set {\<aa>}) x,
	+ x
	+ ]\<^sub>\<circ>
	+ )"
	+ and [cat_cs_simps]: "ntcf_pointed \<alpha> \<aa>\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)"
	+ and [cat_cs_simps]: "ntcf_pointed \<alpha> \<aa>\<lparr>NTCod\<rparr> = cf_id (cat_Set \<alpha>)"
	+ and [cat_cs_simps]: "ntcf_pointed \<alpha> \<aa>\<lparr>NTDGDom\<rparr> = cat_Set \<alpha>"
	+ and [cat_cs_simps]: "ntcf_pointed \<alpha> \<aa>\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	+ unfolding ntcf_pointed_def nt_field_simps by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_pointed_components(1)
	+ \|vsv ntcf_pointed_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_pointed_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_pointed_NTMap_app'\|
	+
	+lemma (in \<Z>) ntcf_pointed_NTMap_app_ArrVal_app[cat_cs_simps]:
	+ assumes "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "F : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ shows "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>F\<rparr> = F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by (simp add: assms(2) ntcf_pointed_NTMap_app'[OF assms(1)] arr_Rel_components)
	+
	+lemma (in \<Z>) ntcf_pointed_NTMap_app_is_iso_arr:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr> :
	+ Hom (cat_Set \<alpha>) (set {\<aa>}) X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> X"
	+proof-
	+ interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	+ note app_X = ntcf_pointed_NTMap_app'[OF assms(2)]
	+ show ?thesis
	+ proof(intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI)
	+ show ArrVal_vsv: "vsv (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>)"
	+ unfolding app_X arr_Rel_components by simp
	+ show "vcard (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>) = 3\<^sub>\<nat>"
	+ unfolding app_X arr_Rel_components by (simp add: nat_omega_simps)
	+ show ArrVal_vdomain:
	+ "\<D>\<^sub>\<circ> (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>) = Hom (cat_Set \<alpha>) (set {\<aa>}) X"
	+ unfolding app_X arr_Rel_components by simp
	+ show vrange_left:
	+ "\<R>\<^sub>\<circ> (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	+ ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrCod\<rparr>"
	+ unfolding app_X arr_Rel_components
	+ by
	+ (
	+ auto
	+ simp: in_Hom_iff
	+ intro: cat_Set_cs_intros
	+ intro!: vrange_VLambda_vsubset
	+ )
	+ show "\<R>\<^sub>\<circ> (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>) = X"
	+ proof(intro vsubset_antisym)
	+ show "X \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>)"
	+ proof(intro vsubsetI)
	+ fix x assume prems: "x \<in>\<^sub>\<circ> X"
	+ from assms prems have F_in_vdomain:
	+ "ntcf_paa \<aa> X x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>))"
	+ unfolding app_X arr_Rel_components vdomain_VLambda in_Hom_iff
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from assms prems have x_def:
	+ "x = ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>ntcf_paa \<aa> X x\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>)"
	+ by (subst x_def) (intro vsv.vsv_vimageI2 F_in_vdomain ArrVal_vsv)
	+ qed
	+ qed (use vrange_left in \<open>simp add: app_X arr_Rel_components\<close>)
	+ from assms show "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding app_X arr_Rel_components cat_Set_components(1)
	+ by (intro Set.cat_Hom_in_Vset[OF _ assms(2)])
	+ (auto simp: cat_Set_components(1))
	+ show "v11 (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>)"
	+ proof(intro vsv.vsv_valeq_v11I ArrVal_vsv, unfold ArrVal_vdomain in_Hom_iff)
	+ fix F G assume prems:
	+ "F : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ "G : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>F\<rparr> =
	+ ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>G\<rparr>"
	+ note F = cat_Set_is_arrD[OF prems(1)] and G = cat_Set_is_arrD[OF prems(2)]
	+ from prems(3,1,2) assms have F_ArrVal_G_ArrVal: "F\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> = G\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by (cs_prems cs_simp: cat_cs_simps)
	+ interpret F: arr_Set \<alpha> F + G: arr_Set \<alpha> G by (simp_all add: F G)
	+ show "F = G"
	+ proof(rule arr_Set_eqI)
	+ show "arr_Set \<alpha> F" "arr_Set \<alpha> G"
	+ by (intro F.arr_Set_axioms G.arr_Set_axioms)+
	+ show "F\<lparr>ArrVal\<rparr> = G\<lparr>ArrVal\<rparr>"
	+ by
	+ (
	+ rule vsv_eqI,
	+ unfold F.arr_Set_ArrVal_vdomain G.arr_Set_ArrVal_vdomain F(2) G(2)
	+ )
	+ (auto simp: F_ArrVal_G_ArrVal)
	+ qed (simp_all add: F G)
	+ qed
	+ qed (use assms in \<open>auto simp: app_X arr_Rel_components cat_Set_components(1)\<close>)
	+qed
	+
	+lemma (in \<Z>) ntcf_pointed_NTMap_app_is_iso_arr'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "A' = Hom (cat_Set \<alpha>) (set {\<aa>}) X"
	+ and "B' = X"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr> : A' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1,2)
	+ unfolding assms(3-5)
	+ by (rule ntcf_pointed_NTMap_app_is_iso_arr)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_NTMap_app_is_iso_arr'
	+
	+lemmas (in \<Z>) ntcf_pointed_NTMap_app_is_arr'[cat_cs_intros] =
	+ is_iso_arrD(1)[OF \<Z>.ntcf_pointed_NTMap_app_is_iso_arr']
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_NTMap_app_is_arr'
	+
	+
	+subsubsection\<open>Pointed natural transformation is a natural isomorphism\<close>
	+
	+lemma (in \<Z>) ntcf_pointed_is_iso_ntcf:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "ntcf_pointed \<alpha> \<aa> :
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_id (cat_Set \<alpha>) :
	+ cat_Set \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_iso_ntcfI is_ntcfI')
	+
	+ note \<aa> = assms[unfolded cat_Set_components(1)]
	+ from assms have set_\<aa>: "set {\<aa>} \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components by auto
	+
	+ show "vfsequence (ntcf_pointed \<alpha> \<aa>)" unfolding ntcf_pointed_def by auto
	+ show "vcard (ntcf_pointed \<alpha> \<aa>) = 5\<^sub>\<nat>"
	+ unfolding ntcf_pointed_def by (auto simp: nat_omega_simps)
	+ from assms set_\<aa> show
	+ "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-) : cat_Set \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ show "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	+ cf_id (cat_Set \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" for a
	+ using assms that set_\<aa>
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+ show
	+ "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha> (set {\<aa>},-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	+ cf_id (cat_Set \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ if "f : a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> b" for a b f
	+ proof-
	+ let ?pb = \<open>ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<close>
	+ and ?pa = \<open>ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<close>
	+ and ?hom = \<open>cf_hom (cat_Set \<alpha>) [cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>set {\<aa>}\<rparr>, f]\<^sub>\<circ>\<close>
	+ from assms set_\<aa> that have pb_hom:
	+ "?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom : Hom (cat_Set \<alpha>) (set {\<aa>}) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> b"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	+ )
	+ then have dom_lhs:
	+ "\<D>\<^sub>\<circ> ((?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom)\<lparr>ArrVal\<rparr>) = Hom (cat_Set \<alpha>) (set {\<aa>}) a"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from assms set_\<aa> that have f_pa:
	+ "f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa : Hom (cat_Set \<alpha>) (set {\<aa>}) a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> b"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ then have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>) = Hom (cat_Set \<alpha>) (set {\<aa>}) a"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ have [cat_cs_simps]: "?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom = f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa"
	+ proof(rule arr_Set_eqI)
	+ from pb_hom show arr_Set_pb_hom: "arr_Set \<alpha> (?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom)"
	+ by (auto dest: cat_Set_is_arrD(1))
	+ from f_pa show arr_Set_f_pa: "arr_Set \<alpha> (f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)"
	+ by (auto dest: cat_Set_is_arrD(1))
	+ show "(?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom)\<lparr>ArrVal\<rparr> = (f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	+ fix g assume "g : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> a"
	+ with assms \<aa> set_\<aa> that show
	+ "(?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?hom)\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = (f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: V_cs_simps cat_cs_simps
	+ cs_intro:
	+ V_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
	+ )
	+ qed (use arr_Set_pb_hom arr_Set_f_pa in auto)
	+ qed (use pb_hom f_pa in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+ from assms that set_\<aa> show ?thesis
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	+ )
	+ qed
	+ show "ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub>
	+ cf_id (cat_Set \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" for a
	+ using assms \<aa> set_\<aa> that
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	+ )
	+
	+qed (auto simp: ntcf_pointed_components intro: cat_cs_intros)
	+
	+lemma (in \<Z>) ntcf_pointed_is_iso_ntcf'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)"
	+ and "\<GG>' = cf_id (cat_Set \<alpha>)"
	+ and "\<AA>' = cat_Set \<alpha>"
	+ and "\<BB>' = cat_Set \<alpha>"
	+ and "\<alpha>' = \<alpha>"
	+ shows "ntcf_pointed \<alpha> \<aa> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	+ using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_is_iso_ntcf)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_is_iso_ntcf'
	+
	+
	+
	+subsection\<open>Inverse pointed natural transformation\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+
	+text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+
	+definition ntcf_pointed_inv :: "V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_pointed_inv \<alpha> \<aa> =
	+ [
	+ (
	+ \<lambda>X\<in>\<^sub>\<circ>cat_Set \<alpha>\<lparr>Obj\<rparr>.
	+ [(\<lambda>x\<in>\<^sub>\<circ>X. ntcf_paa \<aa> X x), X, Hom (cat_Set \<alpha>) (set {\<aa>}) X]\<^sub>\<circ>
	+ ),
	+ cf_id (cat_Set \<alpha>),
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-),
	+ cat_Set \<alpha>,
	+ cat_Set \<alpha>
	+ ]\<^sub>\<circ>"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_pointed_inv_components:
	+ shows "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr> =
	+ (
	+ \<lambda>X\<in>\<^sub>\<circ>cat_Set \<alpha>\<lparr>Obj\<rparr>.
	+ [(\<lambda>x\<in>\<^sub>\<circ>X. ntcf_paa \<aa> X x), X, Hom (cat_Set \<alpha>) (set {\<aa>}) X]\<^sub>\<circ>
	+ )"
	+ and [cat_cs_simps]: "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTDom\<rparr> = cf_id (cat_Set \<alpha>)"
	+ and [cat_cs_simps]:
	+ "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)"
	+ and [cat_cs_simps]: "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTDGDom\<rparr> = cat_Set \<alpha>"
	+ and [cat_cs_simps]: "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	+ unfolding ntcf_pointed_inv_def nt_field_simps
	+ by (simp_all add: nat_omega_simps)
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_pointed_inv_components(1)
	+ \|vsv ntcf_pointed_inv_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_pointed_inv_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_pointed_inv_NTMap_app'\|
	+
	+lemma (in \<Z>) ntcf_pointed_inv_NTMap_app_ArrVal_app[cat_cs_simps]:
	+ assumes "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "x \<in>\<^sub>\<circ> X"
	+ shows "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = ntcf_paa \<aa> X x"
	+ by
	+ (
	+ simp add:
	+ assms(2) ntcf_pointed_inv_NTMap_app'[OF assms(1)] arr_Rel_components
	+ )
	+
	+lemma (in \<Z>) ntcf_pointed_inv_NTMap_app_is_arr:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr> :
	+ X \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom (cat_Set \<alpha>) (set {\<aa>}) X"
	+proof-
	+ interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	+ note app_X = ntcf_pointed_inv_NTMap_app'[OF assms(2)]
	+ show ?thesis
	+ proof(intro cat_Set_is_arrI arr_SetI)
	+ show ArrVal_vsv: "vsv (ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>)"
	+ unfolding app_X arr_Rel_components by simp
	+ show "vcard (ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>) = 3\<^sub>\<nat>"
	+ unfolding app_X arr_Rel_components by (simp add: nat_omega_simps)
	+ show ArrVal_vdomain:
	+ "\<D>\<^sub>\<circ> (ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>) =
	+ ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrDom\<rparr>"
	+ unfolding app_X arr_Rel_components by simp
	+ from assms show vrange_left:
	+ "\<R>\<^sub>\<circ> (ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
	+ ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrCod\<rparr>"
	+ unfolding app_X arr_Rel_components by (auto intro: cat_cs_intros)
	+ from assms show "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ unfolding app_X arr_Rel_components cat_Set_components(1)
	+ by (intro Set.cat_Hom_in_Vset[OF _ assms(2)])
	+ (auto simp: cat_Set_components(1))
	+ qed (use assms in \<open>auto simp: app_X arr_Rel_components cat_Set_components(1)\<close>)
	+qed
	+
	+lemma (in \<Z>) ntcf_pointed_inv_NTMap_app_is_arr'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "A' = X"
	+ and "B' = Hom (cat_Set \<alpha>) (set {\<aa>}) X"
	+ and "\<CC>' = cat_Set \<alpha>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr> : A' \<mapsto>\<^bsub>\<CC>'\<^esub> B'"
	+ using assms(1,2)
	+ unfolding assms(3-5)
	+ by (rule ntcf_pointed_inv_NTMap_app_is_arr)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_inv_NTMap_app_is_arr'
	+
	+lemma (in \<Z>) is_inverse_ntcf_pointed_inv_NTMap_app:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" and "X \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows
	+ "is_inverse
	+ (cat_Set \<alpha>)
	+ (ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>)
	+ (ntcf_pointed \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>X\<rparr>)"
	+ (is \<open>is_inverse (cat_Set \<alpha>) ?bwd ?fwd\<close>)
	+proof(intro is_inverseI)
	+
	+ let ?Hom = \<open>Hom (cat_Set \<alpha>) (set {\<aa>}) X\<close>
	+
	+ interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	+
	+ from assms(1) have set_\<aa>: "set {\<aa>} \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components(1) by blast
	+ have Hom_\<aa>X: "?Hom \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by
	+ (
	+ auto
	+ simp: cat_Set_components(1)
	+ intro!: Set.cat_Hom_in_Vset set_\<aa> assms(2)
	+ )
	+
	+ from assms show "?bwd : X \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Hom"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from assms show "?fwd : ?Hom \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+
	+ from assms set_\<aa> Hom_\<aa>X have lhs_is_arr:
	+ "?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd : ?Hom \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Hom"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd)\<lparr>ArrVal\<rparr>) = ?Hom"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+
	+ from Hom_\<aa>X have rhs_is_arr: "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr> : ?Hom \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Hom"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr>)\<lparr>ArrVal\<rparr>) = ?Hom"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+
	+ show "?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr>"
	+ proof(rule arr_Set_eqI)
	+ from lhs_is_arr show arr_Set_lhs: "arr_Set \<alpha> (?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd)"
	+ by (auto dest: cat_Set_is_arrD)
	+ from rhs_is_arr show arr_Set_rhs: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr>)"
	+ by (auto dest: cat_Set_is_arrD)
	+ show "(?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd)\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr>\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	+ fix F assume "F : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ with assms Hom_\<aa>X show
	+ "(?bwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?fwd)\<lparr>ArrVal\<rparr>\<lparr>F\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?Hom\<rparr>\<lparr>ArrVal\<rparr>\<lparr>F\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps ntcf_paa_ArrVal
	+ cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ )
	+ qed (use arr_Set_lhs arr_Set_rhs in auto)
	+ qed (use lhs_is_arr rhs_is_arr in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+
	+ from assms have lhs_is_arr: "?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd : X \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd)\<lparr>ArrVal\<rparr>) = X"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+
	+ from assms have rhs_is_arr: "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr> : X \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> X"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr>)\<lparr>ArrVal\<rparr>) = X"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+
	+ show "?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr>"
	+ proof(rule arr_Set_eqI)
	+ from lhs_is_arr show arr_Set_lhs: "arr_Set \<alpha> (?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd)"
	+ by (auto dest: cat_Set_is_arrD)
	+ from rhs_is_arr show arr_Set_rhs: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr>)"
	+ by (auto dest: cat_Set_is_arrD)
	+ show "(?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd)\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix x assume "x \<in>\<^sub>\<circ> X"
	+ with assms show
	+ "(?fwd \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?bwd)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>X\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ qed (use arr_Set_lhs arr_Set_rhs in auto)
	+ qed (use lhs_is_arr rhs_is_arr in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+
	+qed
	+
	+
	+subsubsection\<open>Inverse pointed natural transformation is a natural isomorphism\<close>
	+
	+lemma (in \<Z>) ntcf_pointed_inv_is_ntcf:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa> :
	+ cf_id (cat_Set \<alpha>) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-) :
	+ cat_Set \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_ntcfI')
	+
	+ interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
	+
	+ note \<aa> = assms[unfolded cat_Set_components(1)]
	+ from assms have set_\<aa>: "set {\<aa>} \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components by auto
	+
	+ show "vfsequence (ntcf_pointed_inv \<alpha> \<aa>)"
	+ unfolding ntcf_pointed_inv_def by simp
	+ show "vcard (ntcf_pointed_inv \<alpha> \<aa>) = 5\<^sub>\<nat>"
	+ unfolding ntcf_pointed_inv_def by (simp add: nat_omega_simps)
	+ from set_\<aa> show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-) : cat_Set \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+
	+ show "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	+ cf_id (cat_Set \<alpha>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	+ if "a \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" for a
	+ using that assms set_\<aa>
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+ show
	+ "ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_id (cat_Set \<alpha>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
	+ Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	+ ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
	+ if "F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> B" for A B F
	+ proof-
	+ let ?pb = \<open>ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>B\<rparr>\<close>
	+ and ?pa = \<open>ntcf_pointed_inv \<alpha> \<aa>\<lparr>NTMap\<rparr>\<lparr>A\<rparr>\<close>
	+ and ?hom = \<open>cf_hom (cat_Set \<alpha>) [cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>set {\<aa>}\<rparr>, F]\<^sub>\<circ>\<close>
	+ from assms set_\<aa> that have pb_F:
	+ "?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom (cat_Set \<alpha>) (set {\<aa>}) B"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_prod_cs_intros)
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>) = A"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from that assms set_\<aa> that have hom_pa:
	+ "?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa : A \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom (cat_Set \<alpha>) (set {\<aa>}) B"
	+ by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros)
	+ then have dom_rhs: "\<D>\<^sub>\<circ> ((?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>) = A"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ have [cat_cs_simps]: "?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F = ?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa"
	+ proof(rule arr_Set_eqI)
	+ from pb_F show arr_Set_pb_F: "arr_Set \<alpha> (?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)"
	+ by (auto dest: cat_Set_is_arrD(1))
	+ from hom_pa show arr_Set_hom_pa: "arr_Set \<alpha> (?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)"
	+ by (auto dest: cat_Set_is_arrD(1))
	+ show "(?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr> = (?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume "a \<in>\<^sub>\<circ> A"
	+ with assms \<aa> set_\<aa> that show
	+ "(?pb \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> F)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = (?hom \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?pa)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro:
	+ cat_Set_cs_intros
	+ cat_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+ qed (use arr_Set_pb_F arr_Set_hom_pa in auto)
	+ qed (use pb_F hom_pa in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+ from assms that set_\<aa> show ?thesis
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	+ )
	+ qed
	+
	+qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	+
	+lemma (in \<Z>) ntcf_pointed_inv_is_ntcf'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "\<FF>' = cf_id (cat_Set \<alpha>)"
	+ and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)"
	+ and "\<AA>' = cat_Set \<alpha>"
	+ and "\<BB>' = cat_Set \<alpha>"
	+ and "\<alpha>' = \<alpha>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	+ using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_inv_is_ntcf)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_inv_is_ntcf'
	+
	+lemma (in \<Z>) inv_ntcf_ntcf_pointed[cat_cs_simps]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "inv_ntcf (ntcf_pointed \<alpha> \<aa>) = ntcf_pointed_inv \<alpha> \<aa>"
	+ by
	+ (
	+ rule iso_ntcf_if_is_inverse(3)[symmetric],
	+ rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
	+ rule ntcf_pointed_inv_is_ntcf[OF assms],
	+ rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
	+ )
	+
	+lemma (in \<Z>) inv_ntcf_ntcf_pointed_inv[cat_cs_simps]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "inv_ntcf (ntcf_pointed_inv \<alpha> \<aa>) = ntcf_pointed \<alpha> \<aa>"
	+ by
	+ (
	+ rule iso_ntcf_if_is_inverse(4)[symmetric],
	+ rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
	+ rule ntcf_pointed_inv_is_ntcf[OF assms],
	+ rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
	+ )
	+
	+lemma (in \<Z>) ntcf_pointed_inv_is_iso_ntcf:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa> :
	+ cf_id (cat_Set \<alpha>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-) :
	+ cat_Set \<alpha> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by
	+ (
	+ rule iso_ntcf_if_is_inverse(2),
	+ rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
	+ rule ntcf_pointed_inv_is_ntcf[OF assms],
	+ rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
	+ )
	+
	+lemma (in \<Z>) ntcf_pointed_inv_is_iso_ntcf'[cat_cs_intros]:
	+ assumes "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "\<FF>' = cf_id (cat_Set \<alpha>)"
	+ and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha>(set {\<aa>},-)"
	+ and "\<AA>' = cat_Set \<alpha>"
	+ and "\<BB>' = cat_Set \<alpha>"
	+ and "\<alpha>' = \<alpha>"
	+ shows "ntcf_pointed_inv \<alpha> \<aa> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
	+ using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_inv_is_iso_ntcf)
	+
	+lemmas [cat_cs_intros] = \<Z>.ntcf_pointed_inv_is_iso_ntcf'
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Representable.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Representable.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Representable.thy
	@@ -0,0 +1,707 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Representable and corepresentable functors\<close>
	+theory CZH_UCAT_Representable
	+ imports
	+ CZH_Elementary_Categories.CZH_ECAT_Yoneda
	+ CZH_UCAT_Pointed
	+ CZH_UCAT_Limit
	+begin
	+
	+
	+
	+subsection\<open>Representable and corepresentable functors\<close>
	+
	+
	+subsubsection\<open>Definitions and elementary properties\<close>
	+
	+
	+text\<open>
	+See Chapter III-2 in \cite{mac_lane_categories_2010}
	+or Section 2.1 in \cite{riehl_category_2016}.
	+\<close>
	+
	+definition cat_representation :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "cat_representation \<alpha> \<FF> c \<psi> \<longleftrightarrow>
	+ c \<in>\<^sub>\<circ> \<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
	+ \<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomDom\<rparr>(c,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+
	+definition cat_corepresentation :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	+ where "cat_corepresentation \<alpha> \<FF> c \<psi> \<longleftrightarrow>
	+ c \<in>\<^sub>\<circ> \<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
	+ \<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat (\<FF>\<lparr>HomDom\<rparr>)(-,c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<FF>\<lparr>HomDom\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+
	+
	+text\<open>Rules.\<close>
	+
	+context
	+ fixes \<alpha> \<CC> \<FF>
	+ assumes \<FF>: "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+begin
	+
	+interpretation \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule \<FF>)
	+
	+mk_ide rf cat_representation_def[where \<alpha>=\<alpha> and \<FF>=\<FF>, unfolded cat_cs_simps]
	+ \|intro cat_representationI\|
	+ \|dest cat_representationD'\|
	+ \|elim cat_representationE'\|
	+
	+end
	+
	+lemmas cat_representationD[dest] = cat_representationD'[rotated]
	+ and cat_representationE[elim] = cat_representationE'[rotated]
	+
	+lemma cat_corepresentationI:
	+ assumes "category \<alpha> \<CC>"
	+ and "\<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ shows "cat_corepresentation \<alpha> \<FF> c \<psi>"
	+proof-
	+ interpret category \<alpha> \<CC> by (rule assms(1))
	+ interpret \<FF>: is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(2))
	+ note [cat_op_simps] = \<FF>.HomDom.cat_op_cat_cf_Hom_snd[
	+ symmetric, unfolded cat_op_simps, OF assms(3)
	+ ]
	+ show ?thesis
	+ unfolding cat_corepresentation_def
	+ by (intro conjI, unfold cat_cs_simps cat_op_simps; intro assms)
	+qed
	+
	+lemma cat_corepresentationD:
	+ assumes "cat_corepresentation \<alpha> \<FF> c \<psi>"
	+ and "category \<alpha> \<CC>"
	+ and "\<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ shows "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof-
	+ interpret category \<alpha> \<CC> by (rule assms(2))
	+ interpret \<FF>: is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(3))
	+ note c\<psi> = cat_corepresentation_def[
	+ THEN iffD1, OF assms(1), unfolded cat_cs_simps cat_op_simps
	+ ]
	+ from c\<psi>(1) show c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+ note [cat_op_simps] = \<FF>.HomDom.cat_op_cat_cf_Hom_snd[
	+ symmetric, unfolded cat_op_simps, OF c
	+ ]
	+ show "\<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (rule conjunct2[OF c\<psi>, unfolded cat_op_simps])
	+qed
	+
	+lemma cat_corepresentationE:
	+ assumes "cat_corepresentation \<alpha> \<FF> c \<psi>"
	+ and "category \<alpha> \<CC>"
	+ and "\<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ obtains "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ and "\<psi> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (simp add: cat_corepresentationD[OF assms])
	+
	+
	+subsubsection\<open>Representable functors and universal arrows\<close>
	+
	+lemma universal_arrow_of_if_cat_representation:
	+ \<comment>\<open>See Proposition 2 in Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ and "cat_representation \<alpha> \<KK> r \<psi>"
	+ and "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "universal_arrow_of
	+ \<KK> (set {\<aa>}) r (ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) (\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>))"
	+proof-
	+ note r\<psi> = cat_representationD[OF assms(2,1)]
	+ interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))
	+ interpret \<psi>: is_iso_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<psi>
	+ by (rule r\<psi>(2))
	+ from assms(3) have set_\<aa>: "set {\<aa>} \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (simp add: Limit_vsingleton_in_VsetI cat_Set_components(1))
	+ from
	+ ntcf_cf_comp_is_iso_ntcf[
	+ OF \<KK>.ntcf_pointed_inv_is_iso_ntcf[OF assms(3)] assms(1)
	+ ]
	+ have \<aa>\<KK>: "ntcf_pointed_inv \<alpha> \<aa> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> :
	+ \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>cat_Set \<alpha> (set {\<aa>},-) \<circ>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_prems cs_simp: cat_cs_simps)
	+ from iso_ntcf_is_iso_arr(1)[OF \<aa>\<KK>] r\<psi> assms(3) have [cat_cs_simps]:
	+ "((ntcf_pointed_inv \<alpha> \<aa> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>)\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>) =
	+ ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) (\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>)"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_Set_cs_intros cat_cs_intros cat_op_intros
	+ )
	+ show "universal_arrow_of
	+ \<KK> (set {\<aa>}) r (ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) (\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>))"
	+ by
	+ (
	+ rule \<KK>.cf_universal_arrow_of_if_is_iso_ntcf
	+ [
	+ OF r\<psi>(1) set_\<aa> ntcf_vcomp_is_iso_ntcf[OF \<aa>\<KK> r\<psi>(2)],
	+ unfolded cat_cs_simps
	+ ]
	+ )
	+qed
	+
	+lemma universal_arrow_of_if_cat_corepresentation:
	+ \<comment>\<open>See Proposition 2 in Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "category \<alpha> \<CC>"
	+ and "\<KK> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ and "cat_corepresentation \<alpha> \<KK> r \<psi>"
	+ and "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ shows "universal_arrow_of
	+ \<KK> (set {\<aa>}) r (ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) (\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>))"
	+proof-
	+ interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	+ note r\<psi> = cat_corepresentationD[OF assms(3,1,2)]
	+ note [cat_op_simps] = \<CC>.cat_op_cat_cf_Hom_snd[OF r\<psi>(1)]
	+ have rep: "cat_representation \<alpha> \<KK> r \<psi>"
	+ by (intro cat_representationI, rule assms(2), unfold cat_op_simps; rule r\<psi>)
	+ show ?thesis
	+ by
	+ (
	+ rule universal_arrow_of_if_cat_representation[
	+ OF assms(2) rep assms(4), unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+lemma cat_representation_if_universal_arrow_of:
	+ \<comment>\<open>See Proposition 2 in Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ and "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "universal_arrow_of \<KK> (set {\<aa>}) r u"
	+ shows "cat_representation \<alpha> \<KK> r (Yoneda_arrow \<alpha> \<KK> r (u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>))"
	+proof-
	+
	+ let ?Y = \<open>Yoneda_component \<KK> r (u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>)\<close>
	+
	+ interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1))
	+
	+ note ua = \<KK>.universal_arrow_ofD[OF assms(3)]
	+
	+ from ua(2) have u\<aa>: "u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ )
	+
	+ have [cat_cs_simps]: "Yoneda_arrow \<alpha> \<KK> r (u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = ?Y c"
	+ if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	+ using that
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from ua(1) have [cat_cs_simps]: "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = Hom \<CC> r c"
	+ if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
	+ using that
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_op_intros)
	+
	+ show ?thesis
	+ proof
	+ (
	+ intro cat_representationI is_iso_ntcfI,
	+ rule assms(1),
	+ rule ua(1),
	+ rule \<KK>.HomDom.cat_Yoneda_arrow_is_ntcf[OF assms(1) ua(1) u\<aa>],
	+ rule cat_Set_is_iso_arrI,
	+ simp_all only: cat_cs_simps
	+ )
	+
	+ fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
	+ with ua(1,2) show Yc: "?Y c : Hom \<CC> r c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ )
	+
	+ note YcD = cat_Set_is_arrD[OF Yc]
	+
	+ interpret Yc: arr_Set \<alpha> \<open>?Y c\<close> by (rule YcD(1))
	+
	+ show dom_Yc: "\<D>\<^sub>\<circ> (?Y c\<lparr>ArrVal\<rparr>) = Hom \<CC> r c"
	+ by (simp add: \<KK>.Yoneda_component_ArrVal_vdomain)
	+
	+ show "v11 (?Y c\<lparr>ArrVal\<rparr>)"
	+ proof(intro Yc.ArrVal.vsv_valeq_v11I, unfold dom_Yc in_Hom_iff)
	+
	+ fix g f assume prems':
	+ "g : r \<mapsto>\<^bsub>\<CC>\<^esub> c" "f : r \<mapsto>\<^bsub>\<CC>\<^esub> c" "?Y c\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?Y c\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+
	+ from prems have c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
	+
	+ from prems'(3,1,2) have \<KK>gu\<aa>_\<KK>fu\<aa>:
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>\<rparr> = \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>\<rparr>"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+ from prems'(1,2) ua(1,2) have \<KK>g_u:
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ and \<KK>f_u:
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
	+ then have dom_lhs: "\<D>\<^sub>\<circ> ((\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ and dom_rhs: "\<D>\<^sub>\<circ> ((\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>) = set {\<aa>}"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	+
	+ have \<KK>g_\<KK>f: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u = \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u"
	+ proof(rule arr_Set_eqI)
	+ from \<KK>g_u show arr_Set_\<KK>g_u: "arr_Set \<alpha> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)"
	+ by (auto dest: cat_Set_is_arrD)
	+ from \<KK>f_u show arr_Set_\<KK>f_u: "arr_Set \<alpha> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)"
	+ by (auto dest: cat_Set_is_arrD)
	+ show
	+ "(\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr> =
	+ (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs vsingleton_iff; (simp only:)?)
	+ from prems'(1,2) ua(2) show
	+ "(\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> =
	+ (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps \<KK>gu\<aa>_\<KK>fu\<aa>
	+ cs_intro: V_cs_intros cat_cs_intros
	+ )
	+ qed (use arr_Set_\<KK>g_u arr_Set_\<KK>f_u in auto)
	+ qed (use \<KK>g_u \<KK>f_u in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+
	+ from prems'(1) ua(2) have
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u : set {\<aa>} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from ua(3)[OF c this] obtain h where h: "h : r \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and \<KK>g_u_def:
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	+ and h_unique: "\<And>h'.
	+ \<lbrakk>
	+ h' : r \<mapsto>\<^bsub>\<CC>\<^esub> c;
	+ \<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>h'\<rparr>
	+ \<rbrakk> \<Longrightarrow> h' = h"
	+ by metis
	+ from prems'(1,2) ua(2) have
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	+ "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps \<KK>g_\<KK>f cs_intro: cat_cs_intros
	+ )+
	+ from h_unique[OF prems'(1) this(1)] h_unique[OF prems'(2) this(2)] show
	+ "g = f"
	+ by simp
	+ qed
	+
	+ show "\<R>\<^sub>\<circ> (?Y c\<lparr>ArrVal\<rparr>) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ proof
	+ (
	+ intro
	+ vsubset_antisym Yc.arr_Par_ArrVal_vrange[unfolded YcD]
	+ vsubsetI
	+ )
	+ fix y assume prems': "y \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
	+ from prems have \<KK>c: "\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ from ua(3)[OF prems \<KK>.ntcf_paa_is_arr[OF assms(2) \<KK>c prems']] obtain f
	+ where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> c"
	+ and ntcf_paa_y:
	+ "ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) y = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ and f_unique: "\<And>f'.
	+ \<lbrakk>
	+ f' : r \<mapsto>\<^bsub>\<CC>\<^esub> c;
	+ ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) y = umap_of \<KK> (set {\<aa>}) r u c\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ by metis
	+ from ntcf_paa_y f ua(2) have
	+ "ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) y = \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ then have
	+ "ntcf_paa \<aa> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) y\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr> =
	+ (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u)\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>"
	+ by simp
	+ from this f ua(2) have [symmetric, cat_cs_simps]:
	+ "y = \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>\<rparr>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
	+ )
	+ show "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (?Y c\<lparr>ArrVal\<rparr>)"
	+ by (intro Yc.ArrVal.vsv_vimageI2')
	+ (
	+ use f in
	+ \<open>
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ \<close>
	+ )+
	+ qed
	+ qed
	+
	+qed
	+
	+lemma cat_corepresentation_if_universal_arrow_of:
	+ \<comment>\<open>See Proposition 2 in Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
	+ assumes "category \<alpha> \<CC>"
	+ and "\<KK> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ and "\<aa> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ and "universal_arrow_of \<KK> (set {\<aa>}) r u"
	+ shows "cat_corepresentation \<alpha> \<KK> r (Yoneda_arrow \<alpha> \<KK> r (u\<lparr>ArrVal\<rparr>\<lparr>\<aa>\<rparr>))"
	+proof-
	+ interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
	+ interpret \<KK>: is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(2))
	+ note ua = \<KK>.universal_arrow_ofD[OF assms(4), unfolded cat_op_simps]
	+ note [cat_op_simps] = \<CC>.cat_op_cat_cf_Hom_snd[OF ua(1)]
	+ show ?thesis
	+ by
	+ (
	+ intro cat_corepresentationI,
	+ rule assms(1),
	+ rule assms(2),
	+ rule ua(1),
	+ rule cat_representationD(2)
	+ [
	+ OF
	+ cat_representation_if_universal_arrow_of[OF assms(2,3,4)]
	+ assms(2),
	+ unfolded cat_op_simps
	+ ]
	+ )
	+qed
	+
	+
	+
	+subsection\<open>Limits and colimits as universal cones\<close>
	+
	+lemma is_tm_cat_limit_if_cat_corepresentation:
	+ \<comment>\<open>See Definition 3.1.5 in Section 3.1 in \cite{riehl_category_2016}.\<close>
	+ assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ and "cat_corepresentation \<alpha> (tm_cf_Cone \<alpha> \<FF>) r \<psi>"
	+ (is \<open>cat_corepresentation \<alpha> ?Cone r \<psi>\<close>)
	+ shows "ntcf_of_ntcf_arrow \<JJ> \<CC> (\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>) :
	+ r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ (is \<open>ntcf_of_ntcf_arrow \<JJ> \<CC> ?\<psi>r1r : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
	+proof-
	+
	+ let ?P = \<open>ntcf_paa 0\<close> and ?Funct = \<open>cat_Funct \<alpha> \<JJ> \<CC>\<close>
	+
	+ interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
	+ interpret Funct: category \<alpha> ?Funct
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ note r\<psi> = cat_corepresentationD[
	+ OF assms(2) \<FF>.HomCod.category_axioms \<FF>.tm_cf_cf_Cone_is_functor
	+ ]
	+ interpret \<psi>: is_iso_ntcf \<alpha> \<open>op_cat \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r)\<close> ?Cone \<psi>
	+ by (rule r\<psi>(2))
	+ have 0: "0 \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" unfolding cat_Set_components by auto
	+ note ua = universal_arrow_of_if_cat_corepresentation[
	+ OF \<FF>.HomCod.category_axioms \<FF>.tm_cf_cf_Cone_is_functor assms(2) 0
	+ ]
	+
	+ show ?thesis
	+ proof(rule is_tm_cat_limitI')
	+
	+ from r\<psi>(1) have [cat_FUNCT_cs_simps]:
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r)) = cf_const \<JJ> \<CC> r"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ from \<psi>.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF r\<psi>(1)] r\<psi>(1) have
	+ "\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr> :
	+ Hom \<CC> r r \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom ?Funct (cf_map (cf_const \<JJ> \<CC> r)) (cf_map \<FF>)"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_small_cs_simps cat_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros
	+ )
	+ with r\<psi>(1) have \<psi>r_r:
	+ "?\<psi>r1r : cf_map (cf_const \<JJ> \<CC> r) \<mapsto>\<^bsub>?Funct\<^esub> cf_map \<FF>"
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_Set_cs_intros cat_cs_intros in_Hom_iff[symmetric]
	+ )
	+
	+ from r\<psi>(1) cat_Funct_is_arrD(1)[OF \<psi>r_r, unfolded cat_FUNCT_cs_simps]
	+ show "ntcf_of_ntcf_arrow \<JJ> \<CC> ?\<psi>r1r : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ by (intro is_tm_cat_coneI)
	+ (cs_concl cs_shallow cs_intro: cat_cs_intros cat_small_cs_intros)
	+
	+ fix r' u' assume "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ then interpret u': is_tm_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> u' .
	+
	+ have Cone_r': "tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_intro: cat_lim_cs_intros cat_cs_intros cat_op_intros)
	+ from r\<psi>(1) have Cone_r: "tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
	+ from r\<psi>(1) have \<psi>r1r:
	+ "\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> \<in>\<^sub>\<circ> tm_cf_Cone \<alpha> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_small_cs_simps cat_cs_simps cat_op_simps
	+ cs_intro: cat_cs_intros
	+ )
	+ have u': "ntcf_arrow u' \<in>\<^sub>\<circ> ?Cone\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_small_cs_simps
	+ cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
	+ )
	+
	+ have [cat_cs_simps]:
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
	+ "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r)) = cf_const \<JJ> \<CC> r"
	+ by (cs_concl cs_simp: cat_FUNCT_cs_simps)+
	+
	+ from Cone_r 0 \<psi>r1r r\<psi>(1) have \<psi>r1r_is_arr: "\<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> :
	+ cf_map (cf_const \<JJ> \<CC> r) \<mapsto>\<^bsub>?Funct\<^esub> cf_map \<FF>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_small_cs_simps
	+ cs_intro: cat_cs_intros cat_op_intros
	+ )
	+
	+ from r\<psi>(1) have [cat_cs_intros]:
	+ "Hom ?Funct (cf_map (cf_const \<JJ> \<CC> r)) (cf_map \<FF>) \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components(1)
	+ by (intro Funct.cat_Hom_in_Vset)
	+ (
	+ cs_concl
	+ cs_simp: cat_FUNCT_cs_simps
	+ cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
	+ )+
	+
	+ note \<psi>r1r_is_arrD = cat_Funct_is_arrD[OF \<psi>r1r_is_arr, unfolded cat_cs_simps]
	+
	+ from is_functor.universal_arrow_ofD(3)
	+ [
	+ OF \<FF>.tm_cf_cf_Cone_is_functor ua,
	+ unfolded cat_op_simps,
	+ OF u'.cat_cone_obj \<FF>.ntcf_paa_is_arr[OF 0 Cone_r' u']
	+ ]
	+ obtain f where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ and Pf: "?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>) (ntcf_arrow u') =
	+ umap_of ?Cone (set {0}) r (?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) ?\<psi>r1r) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ and f_unique: "\<And>f'.
	+ \<lbrakk>
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
	+ ?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>) (ntcf_arrow u') =
	+ umap_of ?Cone (set {0}) r (?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) ?\<psi>r1r) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ by metis
	+
	+ show "\<exists>!f.
	+ f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and>
	+ u' = ntcf_of_ntcf_arrow \<JJ> \<CC> ?\<psi>r1r \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
	+ from Pf Cone_r 0 f \<psi>r1r \<psi>r1r_is_arr \<psi>r1r_is_arrD(1) show
	+ "u' = ntcf_of_ntcf_arrow \<JJ> \<CC> ?\<psi>r1r \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ by (subst (asm) \<psi>r1r_is_arrD(2))
	+ (
	+ cs_prems
	+ cs_simp: cat_FUNCT_cs_simps cat_small_cs_simps cat_cs_simps
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+
	+ fix f' assume prems:
	+ "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ "u' = ntcf_of_ntcf_arrow \<JJ> \<CC> ?\<psi>r1r \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
	+ from Pf Cone_r 0 f \<psi>r1r \<psi>r1r_is_arr \<psi>r1r_is_arrD(1) prems(1) have
	+ "?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>) (ntcf_arrow u') =
	+ umap_of ?Cone (set {0}) r (?P (?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) ?\<psi>r1r) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ by (subst \<psi>r1r_is_arrD(2))
	+ (
	+ cs_concl
	+ cs_simp: cat_FUNCT_cs_simps cat_small_cs_simps cat_cs_simps prems(2)
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_cs_intros
	+ cat_prod_cs_intros
	+ cat_op_intros
	+ )
	+ from f_unique[OF prems(1) this] show "f' = f" .
	+ qed
	+
	+ qed
	+
	+qed
	+
	+lemma cat_corepresentation_if_is_tm_cat_limit:
	+ \<comment>\<open>See Definition 3.1.5 in Section 3.1 in \cite{riehl_category_2016}.\<close>
	+ assumes "\<psi> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
	+ shows "cat_corepresentation
	+ \<alpha> (tm_cf_Cone \<alpha> \<FF>) r (Yoneda_arrow \<alpha> (tm_cf_Cone \<alpha> \<FF>) r (ntcf_arrow \<psi>))"
	+ (is \<open>cat_corepresentation \<alpha> ?Cone r ?Y\<psi>\<close>)
	+proof-
	+
	+ let ?Funct = \<open>cat_Funct \<alpha> \<JJ> \<CC>\<close>
	+ and ?P_\<psi> = \<open>ntcf_paa 0 (?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>) (ntcf_arrow \<psi>)\<close>
	+ and ?ntcf_of = \<open>ntcf_of_ntcf_arrow \<JJ> \<CC>\<close>
	+
	+ interpret \<psi>: is_tm_cat_limit \<alpha> \<JJ> \<CC> \<FF> r \<psi> by (rule assms(1))
	+ interpret Funct: category \<alpha> ?Funct
	+ by
	+ (
	+ cs_concl cs_shallow cs_intro:
	+ cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
	+ )
	+ interpret Cone: is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>?Cone\<close>
	+ by (rule \<psi>.NTCod.tm_cf_cf_Cone_is_functor)
	+
	+ have 0: "0 \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" unfolding cat_Set_components by auto
	+ have ntcf_arrow_\<psi>:
	+ "ntcf_arrow \<psi> : cf_map (cf_const \<JJ> \<CC> r) \<mapsto>\<^bsub>?Funct\<^esub> cf_map \<FF>"
	+ by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
	+ from \<psi>.cat_cone_obj 0 ntcf_arrow_\<psi> have P_\<psi>:
	+ "?P_\<psi> : set {0} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_intro: cat_cs_intros cat_op_intros
	+ cs_simp: cat_small_cs_simps cat_FUNCT_cs_simps
	+ )
	+
	+ have "universal_arrow_of ?Cone (set {0}) r ?P_\<psi>"
	+ proof(rule Cone.universal_arrow_ofI, unfold cat_op_simps, rule \<psi>.cat_cone_obj)
	+
	+ from 0 \<psi>.cat_cone_obj show "?P_\<psi> : set {0} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Cone\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_op_intros
	+ cs_simp: cat_small_cs_simps
	+ )
	+
	+ fix r' u' assume prems:
	+ "r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : set {0} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Cone\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+
	+ let ?const_r' = \<open>cf_map (cf_const \<JJ> \<CC> r')\<close>
	+ let ?Hom_r\<FF> = \<open>Hom ?Funct ?const_r' (cf_map \<FF>)\<close>
	+
	+ from prems(2,1) have u': "u' : set {0} \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> ?Hom_r\<FF>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_small_cs_simps cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ from prems(1) have [cat_FUNCT_cs_simps]:
	+ "cf_of_cf_map \<JJ> \<CC> ?const_r' = cf_const \<JJ> \<CC> r'"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	+ )
	+
	+ from
	+ cat_Set_ArrVal_app_vrange[OF prems(2) vintersection_vsingleton]
	+ prems(1)
	+ have "u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr> : ?const_r' \<mapsto>\<^bsub>?Funct\<^esub> cf_map \<FF>"
	+ by (cs_prems cs_shallow cs_simp: cat_small_cs_simps cat_cs_simps)
	+ note u'0 = cat_Funct_is_arrD[OF this, unfolded cat_FUNCT_cs_simps]
	+
	+ interpret u'0: is_tm_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> \<open>?ntcf_of (u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>)\<close>
	+ by
	+ (
	+ rule is_tm_cat_coneI[
	+ OF is_tm_ntcfD(1)[OF u'0(1)] \<psi>.NTCod.is_tm_functor_axioms prems(1)
	+ ]
	+ )
	+
	+ from \<psi>.tm_cat_lim_ua_fo[OF u'0.is_cat_cone_axioms] obtain f
	+ where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ and u'0_def: "?ntcf_of (u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>) = \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
	+ and f_unique: "\<And>f'.
	+ \<lbrakk>
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
	+ ?ntcf_of (u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>) = \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'
	+ \<rbrakk> \<Longrightarrow> f' = f"
	+ by metis
	+
	+ note [cat_FUNCT_cs_simps] =
	+ \<psi>.ntcf_paa_ArrVal u'0(2)[symmetric] u'0_def[symmetric]
	+
	+ show "\<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = umap_of ?Cone (set {0}) r ?P_\<psi> r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ proof(intro ex1I conjI; (elim conjE)?; (rule f)?)
	+
	+ from f 0 u' ntcf_arrow_\<psi> show
	+ "u' = umap_of ?Cone (set {0}) r ?P_\<psi> r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ by (slow)
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_prod_cs_intros
	+ cat_cs_intros
	+ cat_op_intros
	+ cs_simp: cat_FUNCT_cs_simps cat_small_cs_simps
	+ )
	+
	+ fix f' assume prems':
	+ "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
	+ "u' = umap_of ?Cone (set {0}) r ?P_\<psi> r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+
	+ let ?f' = \<open>ntcf_const \<JJ> \<CC> f'\<close>
	+
	+ from prems'(2,1) 0 ntcf_arrow_\<psi> P_\<psi> have
	+ "u' = ntcf_paa 0 ?Hom_r\<FF> (ntcf_arrow (\<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?f'))"
	+ unfolding
	+ Cone.umap_of_ArrVal_app[unfolded cat_op_simps, OF prems'(1) P_\<psi>]
	+ by (very slow)
	+ (
	+ cs_prems
	+ cs_simp: cat_FUNCT_cs_simps cat_small_cs_simps cat_cs_simps
	+ cs_intro:
	+ cat_small_cs_intros
	+ cat_FUNCT_cs_intros
	+ cat_prod_cs_intros
	+ cat_cs_intros
	+ cat_op_intros
	+ )
	+ then have
	+ "?ntcf_of (u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>) =
	+ ?ntcf_of ((ntcf_paa 0 ?Hom_r\<FF> (ntcf_arrow (\<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?f')))\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>)"
	+ by simp
	+ from this prems'(1) have "?ntcf_of (u'\<lparr>ArrVal\<rparr>\<lparr>0\<rparr>) = \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?f'"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
	+ )
	+ from f_unique[OF prems'(1) this] show "f' = f" .
	+
	+ qed
	+
	+ qed
	+
	+ from
	+ cat_corepresentation_if_universal_arrow_of[
	+ OF \<psi>.NTDom.HomCod.category_axioms Cone.is_functor_axioms 0 this
	+ ]
	+ show "cat_corepresentation \<alpha> ?Cone r ?Y\<psi>"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps)
	+
	+qed
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Set.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Set.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Set.thy
	@@ -0,0 +1,955 @@
	+(* Copyright 2021 (C) Mihails Milehins *)
	+
	+section\<open>Category \<open>Set\<close> and universal constructions\<close>
	+theory CZH_UCAT_Set
	+ imports CZH_UCAT_Complete
	+begin
	+
	+
	+
	+subsection\<open>Discrete functor with tiny maps to the category \<open>Set\<close>\<close>
	+
	+lemma (in \<Z>) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
	+ assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "tm_cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	+proof(intro tm_cf_discreteI)
	+ from assms have vrange_F_in_Vset: "\<R>\<^sub>\<circ> (VLambda I F) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto intro: vrange_in_VsetI)
	+ show "(\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule vbrelation.vbrelation_Limit_in_VsetI)
	+ from assms show "\<D>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (metis vdomain_VLambda vdomain_in_VsetI)
	+ define Q where
	+ "Q i =
	+ (
	+ if i = 0
	+ then VPow ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i))
	+ else set (F ` elts I)
	+ )"
	+ for i :: V
	+ have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ proof(intro vsubsetI, unfold cat_Set_components)
	+ fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. VLambda (Vset \<alpha>) id_Set\<lparr>F i\<rparr>)"
	+ then obtain i where i: "i \<in>\<^sub>\<circ> I"
	+ and y_def: "y = VLambda (Vset \<alpha>) id_Set\<lparr>F i\<rparr>"
	+ by auto
	+ from i have "F i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I F)" by auto
	+ with vrange_F_in_Vset have "F i \<in>\<^sub>\<circ> Vset \<alpha>" by auto
	+ then have y_def: "y = id_Set (F i)" unfolding y_def by auto
	+ show "y \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
	+ unfolding y_def
	+ proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
	+ show "\<D>\<^sub>\<circ> (id_Rel (F i)) = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	+ by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
	+ fix j assume "j \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
	+ then consider \<open>j = 0\<close> \| \<open>j = 1\<^sub>\<nat>\<close> \| \<open>j = 2\<^sub>\<nat>\<close> by auto
	+ then show "id_Rel (F i)\<lparr>j\<rparr> \<in>\<^sub>\<circ> Q j"
	+ proof cases
	+ case 1
	+ from i show ?thesis
	+ unfolding 1
	+ by
	+ (
	+ subst arr_field_simps(1)[symmetric],
	+ unfold id_Rel_components Q_def
	+ )
	+ force
	+ next
	+ case 2
	+ from i show ?thesis
	+ unfolding 2
	+ by
	+ (
	+ subst arr_field_simps(2)[symmetric],
	+ unfold id_Rel_components Q_def
	+ )
	+ auto
	+ next
	+ case 3
	+ from i show ?thesis
	+ unfolding 3
	+ by
	+ (
	+ subst arr_field_simps(3)[symmetric],
	+ unfold id_Rel_components Q_def
	+ )
	+ auto
	+ qed
	+ qed (auto simp: id_Rel_def cat_Set_cs_intros)
	+ qed
	+ moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ proof(rule Limit_vproduct_in_VsetI)
	+ show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>" unfolding three[symmetric] by simp
	+ from assms have "VPow ((\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by
	+ (
	+ intro
	+ Limit_VPow_in_VsetI
	+ Limit_vtimes_in_VsetI
	+ Limit_vifunion_in_Vset_if_VLambda_in_VsetI
	+ )
	+ auto
	+ then show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
	+ using that vrange_VLambda
	+ by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
	+ qed auto
	+ ultimately show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>F i\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (meson vsubset_in_VsetI)
	+ qed auto
	+ fix i assume prems: "i \<in>\<^sub>\<circ> I"
	+ from assms have "\<R>\<^sub>\<circ> (VLambda I F) \<in>\<^sub>\<circ> Vset \<alpha>" by (auto simp: vrange_in_VsetI)
	+ moreover from prems have "F i \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (VLambda I F)" by auto
	+ ultimately show "F i \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" unfolding cat_Set_components by auto
	+qed (cs_concl cs_shallow cs_intro: cat_cs_intros assms)+
	+
	+
	+
	+subsection\<open>Product cone and coproduct cocone for the category \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+definition ntcf_Set_obj_prod :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "ntcf_Set_obj_prod \<alpha> I F = ntcf_obj_prod_base
	+ (cat_Set \<alpha>) I F (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) (\<lambda>i. vprojection_arrow I F i)"
	+
	+definition ntcf_Set_obj_coprod :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
	+ where "ntcf_Set_obj_coprod \<alpha> I F = ntcf_obj_coprod_base
	+ (cat_Set \<alpha>) I F (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) (\<lambda>i. vcinjection_arrow I F i)"
	+
	+
	+text\<open>Components.\<close>
	+
	+lemma ntcf_Set_obj_prod_components:
	+ shows "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTMap\<rparr> =
	+ (\<lambda>i\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. vprojection_arrow I F i)"
	+ and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDom\<rparr> =
	+ cf_const (:\<^sub>C I) (cat_Set \<alpha>) (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTCod\<rparr> = :\<rightarrow>: I F (cat_Set \<alpha>)"
	+ and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	+ and "ntcf_Set_obj_prod \<alpha> I F\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	+ unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all
	+
	+lemma ntcf_Set_obj_coprod_components:
	+ shows "ntcf_Set_obj_coprod \<alpha> I F\<lparr>NTMap\<rparr> =
	+ (\<lambda>i\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. vcinjection_arrow I F i)"
	+ and "ntcf_Set_obj_coprod \<alpha> I F\<lparr>NTDom\<rparr> = :\<rightarrow>: I F (cat_Set \<alpha>)"
	+ and "ntcf_Set_obj_coprod \<alpha> I F\<lparr>NTCod\<rparr> =
	+ cf_const (:\<^sub>C I) (cat_Set \<alpha>) (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ and "ntcf_Set_obj_coprod \<alpha> I F\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
	+ and "ntcf_Set_obj_coprod \<alpha> I F\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	+ unfolding ntcf_Set_obj_coprod_def ntcf_obj_coprod_base_components by simp_all
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_Set_obj_prod_components(1)
	+ \|vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]\|
	+
	+mk_VLambda ntcf_Set_obj_coprod_components(1)
	+ \|vsv ntcf_Set_obj_coprod_NTMap_vsv[cat_cs_intros]\|
	+ \|vdomain ntcf_Set_obj_coprod_NTMap_vdomain[cat_cs_simps]\|
	+ \|app ntcf_Set_obj_coprod_NTMap_app[cat_cs_simps]\|
	+
	+
	+subsubsection\<open>
	+Product cone for the category \<open>Set\<close> is a universal cone and product cocone
	+for the category \<open>Set\<close> is a universal cocone
	+\<close>
	+
	+lemma (in \<Z>) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
	+ \<comment>\<open>See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	+ assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "ntcf_Set_obj_prod \<alpha> I F :
	+ (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_cat_obj_prodI is_cat_limitI)
	+
	+ interpret Set: tm_cf_discrete \<alpha> I F \<open>cat_Set \<alpha>\<close>
	+ by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])
	+
	+ let ?F = \<open>ntcf_Set_obj_prod \<alpha> I F\<close>
	+
	+ show "cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	+ by (auto simp: cat_small_discrete_cs_intros)
	+ show F_is_cat_cone: "?F :
	+ (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F (cat_Set \<alpha>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ unfolding ntcf_Set_obj_prod_def
	+ proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
	+ show "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components
	+ by
	+ (
	+ intro
	+ Limit_vproduct_in_Vset_if_VLambda_in_VsetI
	+ Set.tm_cf_discrete_ObjMap_in_Vset
	+ )
	+ auto
	+ qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)
	+
	+ interpret F: is_cat_cone
	+ \<alpha> \<open>\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i\<close> \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<open>?F\<close>
	+ by (rule F_is_cat_cone)
	+
	+ fix \<pi>' P' assume prems:
	+ "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F (cat_Set \<alpha>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+
	+ let ?\<pi>'i = \<open>\<lambda>i. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<close>
	+ let ?up' = \<open>cat_Set_obj_prod_up I F P' ?\<pi>'i\<close>
	+
	+ interpret \<pi>': is_cat_cone \<alpha> P' \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<pi>'
	+ by (rule prems(1))
	+
	+ show "\<exists>!f'.
	+ f' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<and>
	+ \<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f'"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show up': "?up' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
	+ show "P' \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>" by (auto intro: cat_cs_intros cat_lim_cs_intros)
	+ fix i assume "i \<in>\<^sub>\<circ> I"
	+ then show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ the_cat_discrete_components(1)
	+ cat_cs_simps cat_discrete_cs_simps
	+ cs_intro: cat_cs_intros
	+ )
	+ qed (rule assms)
	+
	+ then have P': "P' \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (auto intro: cat_cs_intros cat_lim_cs_intros)
	+
	+ have \<pi>'i_i: "?\<pi>'i i : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> F i" if "i \<in>\<^sub>\<circ> I" for i
	+ using
	+ \<pi>'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
	+ that
	+ by
	+ (
	+ cs_prems cs_shallow cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	+ )
	+
	+ from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) \<pi>'i_i] have \<pi>'i:
	+ "cat_Set_obj_prod_up I F P' ?\<pi>'i : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)".
	+
	+ show "\<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up'"
	+ proof(rule ntcf_eqI, rule \<pi>'.is_ntcf_axioms)
	+
	+ from F_is_cat_cone \<pi>'i show
	+ "?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' :
	+ cf_const (:\<^sub>C I) (cat_Set \<alpha>) P' \<mapsto>\<^sub>C\<^sub>F :\<rightarrow>: I F (cat_Set \<alpha>) :
	+ :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+
	+ have dom_lhs: "\<D>\<^sub>\<circ> (\<pi>'\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from F_is_cat_cone \<pi>'i have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+
	+ show "\<pi>'\<lparr>NTMap\<rparr> = (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix i assume prems': "i \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>"
	+ then have i: "i \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
	+ have [cat_cs_simps]:
	+ "vprojection_arrow I F i \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?up' = \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ rule cat_Set_cf_comp_proj_obj_prod_up[
	+ OF P' assms \<pi>'i_i i, symmetric
	+ ]
	+ )
	+ auto
	+ from \<pi>'i prems' show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> =
	+ (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
	+ )
	+ qed (auto simp: cat_cs_intros)
	+
	+ qed simp_all
	+
	+ fix f' assume prems:
	+ "f' : P' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ "\<pi>' = ?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f'"
	+ from prems(2) have \<pi>'_eq_F_f': "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	+ (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f')\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ if "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> P'" for i a
	+ by simp
	+ have [cat_Set_cs_simps]: "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> = f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr>"
	+ if "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> P'" for i a
	+ using
	+ \<pi>'_eq_F_f'[OF that]
	+ assms prems that
	+ vprojection_arrow_is_arr[OF that(1) assms]
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp:
	+ cat_Set_cs_simps
	+ cat_cs_simps
	+ vprojection_arrow_ArrVal_app
	+ the_cat_discrete_components(1)
	+ cs_intro: cat_Set_cs_intros cat_cs_intros
	+ )
	+
	+ note f' = cat_Set_is_arrD[OF prems(1)]
	+ note up' = cat_Set_is_arrD[OF up']
	+
	+ interpret f': arr_Set \<alpha> f' by (rule f'(1))
	+ interpret u': arr_Set \<alpha> \<open>(cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>)))\<close>
	+ by (rule up'(1))
	+
	+ show "f' = ?up'"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ have dom_lhs: "\<D>\<^sub>\<circ> (f'\<lparr>ArrVal\<rparr>) = P'" by (simp add: cat_Set_cs_simps f')
	+ have dom_rhs:
	+ "\<D>\<^sub>\<circ> (cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>) = P'"
	+ by (simp add: cat_Set_cs_simps up')
	+ show "f'\<lparr>ArrVal\<rparr> = cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems': "a \<in>\<^sub>\<circ> P'"
	+ from prems(1) prems' have "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ by (cs_concl cs_shallow cs_intro: cat_Set_cs_intros)
	+ note f'a = vproductD[OF this]
	+ from prems' have dom_rhs:
	+ "\<D>\<^sub>\<circ> (cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>) = I"
	+ by (cs_concl cs_shallow cs_simp: cat_Set_cs_simps)
	+ show "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	+ cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ proof(rule vsv_eqI, unfold f'a dom_rhs)
	+ fix i assume "i \<in>\<^sub>\<circ> I"
	+ with prems' show "f'\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> =
	+ cat_Set_obj_prod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_Set_cs_simps)
	+ qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
	+ qed auto
	+ qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))
	+
	+ qed
	+
	+qed
	+
	+lemma (in \<Z>) tm_cf_discrete_ntcf_obj_prod_base_is_tm_cat_obj_prod:
	+ \<comment>\<open>See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	+ assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "ntcf_Set_obj_prod \<alpha> I F :
	+ (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) <\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_tm_cat_obj_prodI)
	+ from assms show "tm_cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	+ by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset)
	+ show "ntcf_Set_obj_prod \<alpha> I F :
	+ vproduct I F <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m :\<rightarrow>: I F (cat_Set \<alpha>) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by
	+ (
	+ rule is_cat_obj_prodD[
	+ OF tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod[OF assms]
	+ ]
	+ )
	+qed
	+
	+lemma (in \<Z>) tm_cf_discrete_ntcf_obj_coprod_base_is_cat_obj_coprod:
	+ \<comment>\<open>See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	+ assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "ntcf_Set_obj_coprod \<alpha> I F :
	+ F >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_cat_obj_coprodI is_cat_colimitI)
	+
	+ interpret Set: tm_cf_discrete \<alpha> I F \<open>cat_Set \<alpha>\<close>
	+ by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])
	+
	+ let ?F = \<open>ntcf_Set_obj_coprod \<alpha> I F\<close>
	+
	+ show "cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	+ by (auto simp: cat_small_discrete_cs_intros)
	+ show F_is_cat_cocone: "?F :
	+ :\<rightarrow>: I F (cat_Set \<alpha>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ unfolding ntcf_Set_obj_coprod_def
	+ proof(rule Set.tm_cf_discrete_ntcf_obj_coprod_base_is_cat_cocone)
	+ show "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ unfolding cat_Set_components
	+ by
	+ (
	+ intro
	+ Limit_vdunion_in_Vset_if_VLambda_in_VsetI
	+ Set.tm_cf_discrete_ObjMap_in_Vset
	+ )
	+ auto
	+ qed (intro vcinjection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)
	+ then interpret F: is_cat_cocone
	+ \<alpha> \<open>\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i\<close> \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<open>?F\<close> .
	+
	+ fix \<pi>' P' assume prems:
	+ "\<pi>' : :\<rightarrow>: I F (cat_Set \<alpha>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e P' : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+
	+ let ?\<pi>'i = \<open>\<lambda>i. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<close>
	+ let ?up' = \<open>cat_Set_obj_coprod_up I F P' ?\<pi>'i\<close>
	+
	+ interpret \<pi>': is_cat_cocone \<alpha> P' \<open>:\<^sub>C I\<close> \<open>cat_Set \<alpha>\<close> \<open>:\<rightarrow>: I F (cat_Set \<alpha>)\<close> \<pi>'
	+ by (rule prems(1))
	+
	+ show "\<exists>!f'.
	+ f' : VSigma I F \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P' \<and>
	+ \<pi>' = ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_Set_obj_coprod \<alpha> I F"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ show up': "?up' : (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P'"
	+ proof(rule cat_Set_obj_coprod_up_cat_Set_is_arr)
	+ show "P' \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (auto intro: cat_cs_intros cat_lim_cs_intros)
	+ fix i assume "i \<in>\<^sub>\<circ> I"
	+ then show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps
	+ the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed (rule assms)
	+
	+ then have P': "P' \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
	+ by (auto intro: cat_cs_intros cat_lim_cs_intros)
	+
	+ have \<pi>'i_i: "?\<pi>'i i : F i \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P'" if "i \<in>\<^sub>\<circ> I" for i
	+ using
	+ \<pi>'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
	+ that
	+ by
	+ (
	+ cs_prems cs_shallow cs_simp:
	+ cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
	+ )
	+ from cat_Set_obj_coprod_up_cat_Set_is_arr[OF P' assms(1) \<pi>'i_i] have \<pi>'i:
	+ "?up' : (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P'".
	+
	+ show "\<pi>' = ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F"
	+ proof(rule ntcf_eqI, rule \<pi>'.is_ntcf_axioms)
	+ from F_is_cat_cocone \<pi>'i show
	+ "ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F :
	+ :\<rightarrow>: I F (cat_Set \<alpha>) \<mapsto>\<^sub>C\<^sub>F cf_const (:\<^sub>C I) (cat_Set \<alpha>) P' :
	+ :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	+ have dom_lhs: "\<D>\<^sub>\<circ> (\<pi>'\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from F_is_cat_cocone \<pi>'i have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up')\<lparr>NTMap\<rparr>) = :\<^sub>C I\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "\<pi>'\<lparr>NTMap\<rparr> = (ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F)\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix i assume prems': "i \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>"
	+ then have i: "i \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
	+ have [cat_cs_simps]:
	+ "?up' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> vcinjection_arrow I F i = \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ simp add: cat_Set_cf_comp_coprod_up_vcia[
	+ OF P' assms \<pi>'i_i i, symmetric
	+ ]
	+ )
	+ from \<pi>'i prems' show "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> =
	+ (ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) ?up' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F)\<lparr>NTMap\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
	+ )
	+ qed (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)+
	+ qed simp_all
	+
	+ fix f' assume prems:
	+ "f' : (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> P'"
	+ "\<pi>' = ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F"
	+ from prems(2) have \<pi>'_eq_F_f': "\<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	+ (ntcf_const (:\<^sub>C I) (cat_Set \<alpha>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?F)\<lparr>NTMap\<rparr>\<lparr>i\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ if "i \<in>\<^sub>\<circ> I" and "a \<in>\<^sub>\<circ> P'" for i a
	+ by simp
	+ note f' = cat_Set_is_arrD[OF prems(1)]
	+ note up' = cat_Set_is_arrD[OF up']
	+ interpret f': arr_Set \<alpha> f' by (rule f'(1))
	+ interpret u': arr_Set \<alpha> \<open>(cat_Set_obj_coprod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>)))\<close>
	+ by (rule up'(1))
	+ show "f' = ?up'"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ have dom_lhs: "\<D>\<^sub>\<circ> (f'\<lparr>ArrVal\<rparr>) = (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ by (simp add: cat_Set_cs_simps f')
	+ have dom_rhs:
	+ "\<D>\<^sub>\<circ> (cat_Set_obj_coprod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>) =
	+ (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ by (simp add: cat_Set_cs_simps up')
	+ show "f'\<lparr>ArrVal\<rparr> = cat_Set_obj_coprod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix ix assume prems': "ix \<in>\<^sub>\<circ> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i)"
	+ then obtain i x where ix_def: "ix = \<langle>i, x\<rangle>"
	+ and i: "i \<in>\<^sub>\<circ> I"
	+ and x: "x \<in>\<^sub>\<circ> F i"
	+ by auto
	+ from assms prems(1) prems' i x show "f'\<lparr>ArrVal\<rparr>\<lparr>ix\<rparr> =
	+ cat_Set_obj_coprod_up I F P' (app (\<pi>'\<lparr>NTMap\<rparr>))\<lparr>ArrVal\<rparr>\<lparr>ix\<rparr>"
	+ unfolding ix_def prems(2)
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp:
	+ cat_Set_cs_simps cat_cs_simps the_cat_discrete_components(1)
	+ cs_intro: cat_cs_intros
	+ )
	+ qed auto
	+ qed (simp_all add: cat_Set_obj_coprod_up_components f' up'(1))
	+
	+ qed
	+
	+qed
	+
	+lemma (in \<Z>) ntcf_Set_obj_coprod_is_tm_cat_obj_coprod:
	+ \<comment>\<open>See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	+ assumes "VLambda I F \<in>\<^sub>\<circ> Vset \<alpha>"
	+ shows "ntcf_Set_obj_coprod \<alpha> I F :
	+ F >\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m\<^sub>.\<^sub>\<Coprod> (\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. F i) : I \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_tm_cat_obj_coprodI)
	+ from assms show "tm_cf_discrete \<alpha> I F (cat_Set \<alpha>)"
	+ by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset)
	+ show "ntcf_Set_obj_coprod \<alpha> I F :
	+ :\<rightarrow>: I F (cat_Set \<alpha>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m VSigma I F : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by
	+ (
	+ rule is_cat_obj_coprodD[
	+ OF tm_cf_discrete_ntcf_obj_coprod_base_is_cat_obj_coprod[OF assms]
	+ ]
	+ )
	+qed
	+
	+
	+
	+subsection\<open>Equalizer for the category \<open>Set\<close>\<close>
	+
	+
	+subsubsection\<open>Definition and elementary properties\<close>
	+
	+abbreviation ntcf_Set_equalizer_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_Set_equalizer_map \<alpha> a g f i \<equiv>
	+ (
	+ i = \<aa>\<^sub>P\<^sub>L\<^sub>2 ?
	+ incl_Set (vequalizer a g f) a :
	+ g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer a g f) a
	+ )"
	+
	+definition ntcf_Set_equalizer :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	+ where "ntcf_Set_equalizer \<alpha> a b g f = ntcf_equalizer_base
	+ (cat_Set \<alpha>) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map \<alpha> a g f)"
	+
	+
	+text\<open>Components.\<close>
	+
	+context
	+ fixes a g f \<alpha> :: V
	+begin
	+
	+lemmas ntcf_Set_equalizer_components =
	+ ntcf_equalizer_base_components[
	+ where \<CC>=\<open>cat_Set \<alpha>\<close>
	+ and e=\<open>ntcf_Set_equalizer_map \<alpha> a g f\<close>
	+ and E=\<open>vequalizer a g f\<close>
	+ and \<aa>=a and \<gg>=g and \<ff>=f,
	+ folded ntcf_Set_equalizer_def
	+ ]
	+
	+end
	+
	+
	+subsubsection\<open>Natural transformation map\<close>
	+
	+mk_VLambda ntcf_Set_equalizer_components(1)
	+ \|vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]\|
	+ \|vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]\|
	+ \|app ntcf_Set_equalizer_NTMap_app\|
	+
	+lemma ntcf_Set_equalizer_2_NTMap_app_\<aa>[cat_Set_cs_simps]:
	+ assumes "x = \<aa>\<^sub>P\<^sub>L\<^sub>2"
	+ shows
	+ "ntcf_Set_equalizer \<alpha> a b g f\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	+ incl_Set (vequalizer a g f) a"
	+ unfolding assms the_cat_parallel_2_components(1) ntcf_Set_equalizer_components
	+ by simp
	+
	+lemma ntcf_Set_equalizer_2_NTMap_app_\<bb>[cat_Set_cs_simps]:
	+ assumes "x = \<bb>\<^sub>P\<^sub>L\<^sub>2"
	+ shows
	+ "ntcf_Set_equalizer \<alpha> a b g f\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	+ g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> incl_Set (vequalizer a g f) a"
	+ unfolding assms the_cat_parallel_2_components(1) ntcf_Set_equalizer_components
	+ using cat_PL2_ineq
	+ by auto
	+
	+
	+subsubsection\<open>Equalizer for the category \<open>Set\<close> is an equalizer\<close>
	+
	+lemma (in \<Z>) ntcf_Set_equalizer_2_is_cat_equalizer_2:
	+ assumes "\<gg> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	+ shows "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> :
	+ vequalizer \<aa> \<gg> \<ff> <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+proof(intro is_cat_equalizer_2I is_cat_equalizerI is_cat_limitI)
	+
	+ let ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up>\<^sub>C\<^sub>F (cat_Set \<alpha>) \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
	+ and ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L\<^sub>2 \<bb>\<^sub>P\<^sub>L\<^sub>2 \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
	+
	+ note \<gg> = cat_Set_is_arrD[OF assms(1)]
	+ interpret \<gg>: arr_Set \<alpha> \<gg>
	+ rewrites "\<gg>\<lparr>ArrDom\<rparr> = \<aa>" and "\<gg>\<lparr>ArrCod\<rparr> = \<bb>"
	+ by (rule \<gg>(1)) (simp_all add: \<gg>)
	+ note \<ff> = cat_Set_is_arrD[OF assms(2)]
	+ interpret \<ff>: arr_Set \<alpha> \<ff>
	+ rewrites "\<ff>\<lparr>ArrDom\<rparr> = \<aa>" and "\<ff>\<lparr>ArrCod\<rparr> = \<bb>"
	+ by (rule \<ff>(1)) (simp_all add: \<ff>)
	+
	+ note [cat_Set_cs_intros] = \<gg>.arr_Set_ArrDom_in_Vset \<ff>.arr_Set_ArrCod_in_Vset
	+
	+ let ?incl = \<open>incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa>\<close>
	+
	+ show \<aa>\<bb>\<gg>\<ff>_is_cat_cone: "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> :
	+ vequalizer \<aa> \<gg> \<ff> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ unfolding ntcf_Set_equalizer_def
	+ proof
	+ (
	+ intro
	+ category.cat_ntcf_equalizer_base_is_cat_cone
	+ category.cat_cf_parallel_2_cat_equalizer
	+ )
	+ from assms show
	+ "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) :
	+ vequalizer \<aa> \<gg> \<ff> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps
	+ cs_intro:
	+ V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ cat_PL2_ineq[symmetric]
	+ )
	+ show
	+ "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) =
	+ \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<aa>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps
	+ cs_intro:
	+ V_cs_intros cat_Set_cs_intros cat_cs_intros
	+ cat_PL2_ineq[symmetric]
	+ )
	+ from assms show
	+ "(\<bb>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl) =
	+ \<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<aa>\<^sub>P\<^sub>L\<^sub>2 = \<aa>\<^sub>P\<^sub>L\<^sub>2 ? ?incl : \<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?incl)"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: V_cs_simps cat_Set_incl_Set_commute
	+ cs_intro: V_cs_intros cat_PL2_ineq[symmetric]
	+ )
	+ qed
	+ (
	+ cs_concl
	+ cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms
	+ cs_simp: V_cs_simps cat_cs_simps cat_Set_components(1)
	+ )+
	+
	+ interpret \<aa>\<bb>\<gg>\<ff>: is_cat_cone
	+ \<alpha> \<open>vequalizer \<aa> \<gg> \<ff>\<close> ?II \<open>cat_Set \<alpha>\<close> ?II_II \<open>ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff>\<close>
	+ by (rule \<aa>\<bb>\<gg>\<ff>_is_cat_cone)
	+
	+ show "\<exists>!f'.
	+ f' : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff> \<and>
	+ u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) f'"
	+ if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" for u' r'
	+ proof-
	+
	+ interpret u': is_cat_cone \<alpha> r' ?II \<open>cat_Set \<alpha>\<close> ?II_II u' by (rule that(1))
	+
	+ have "\<aa>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ unfolding the_cat_parallel_2_components(1) by simp
	+ from
	+ u'.ntcf_NTMap_is_arr[OF this]
	+ \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_cf_parallel_2_cat_equalizer[OF assms]
	+ have u'_\<aa>\<^sub>P\<^sub>L_is_arr: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<aa>"
	+ by (cs_prems_atom_step cat_cs_simps)
	+ (
	+ cs_prems
	+ cs_simp: cat_parallel_cs_simps
	+ cs_intro:
	+ cat_parallel_cs_intros
	+ cat_cs_intros
	+ category.cat_cf_parallel_2_cat_equalizer
	+ )
	+ note u'_\<aa>\<^sub>P\<^sub>L = cat_Set_is_arrD[OF u'_\<aa>\<^sub>P\<^sub>L_is_arr]
	+ interpret u'_\<aa>\<^sub>P\<^sub>L: arr_Set \<alpha> \<open>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<close> by (rule u'_\<aa>\<^sub>P\<^sub>L(1))
	+
	+ have "\<bb>\<^sub>P\<^sub>L\<^sub>2 \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_intro: cat_parallel_cs_intros)
	+
	+ from
	+ u'.ntcf_NTMap_is_arr[OF this]
	+ \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_cf_parallel_2_cat_equalizer[OF assms]
	+ have "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>"
	+ by
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_cs_simps cat_parallel_cs_simps
	+ cs_intro: cat_parallel_cs_intros
	+ )
	+
	+ note u'_\<gg>u' = cat_cone_cf_par_2_eps_NTMap_app(1)[OF that(1) assms]
	+
	+ define q where "q = [u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>, r', vequalizer \<aa> \<gg> \<ff>]\<^sub>\<circ>"
	+
	+ have q_components[cat_Set_cs_simps]:
	+ "q\<lparr>ArrVal\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>"
	+ "q\<lparr>ArrDom\<rparr> = r'"
	+ "q\<lparr>ArrCod\<rparr> = vequalizer \<aa> \<gg> \<ff>"
	+ unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)
	+
	+ from cat_cone_cf_par_2_eps_NTMap_app[OF that(1) assms] have \<gg>u'_eq_\<ff>u':
	+ "(\<gg> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr> =
	+ (\<ff> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ for x
	+ by simp
	+
	+ show ?thesis
	+ proof(intro ex1I conjI; (elim conjE)?)
	+
	+ have u'_NTMap_vrange: "\<R>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	+ proof(rule vsubsetI)
	+ fix y assume prems: "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>)"
	+ then obtain x where x: "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>)"
	+ and y_def: "y = u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>"
	+ by (blast dest: u'_\<aa>\<^sub>P\<^sub>L.ArrVal.vrange_atD)
	+ have x: "x \<in>\<^sub>\<circ> r'"
	+ by (use x u'_\<aa>\<^sub>P\<^sub>L_is_arr in \<open>cs_prems cs_shallow cs_simp: cat_cs_simps\<close>)
	+ from \<gg>u'_eq_\<ff>u'[of x] assms x u'_\<aa>\<^sub>P\<^sub>L_is_arr have [simp]:
	+ "\<gg>\<lparr>ArrVal\<rparr>\<lparr>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr> =
	+ \<ff>\<lparr>ArrVal\<rparr>\<lparr>u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>"
	+ by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from prems u'_\<aa>\<^sub>P\<^sub>L.arr_Set_ArrVal_vrange[unfolded u'_\<aa>\<^sub>P\<^sub>L] show
	+ "y \<in>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	+ by (intro vequalizerI, unfold y_def) auto
	+ qed
	+
	+ show q_is_arr: "q : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff>"
	+ proof(intro cat_Set_is_arrI arr_SetI)
	+ show "q\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	+ by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
	+ qed
	+ (
	+ auto
	+ simp:
	+ cat_Set_cs_simps nat_omega_simps
	+ u'_\<aa>\<^sub>P\<^sub>L
	+ q_def
	+ u'_NTMap_vrange
	+ \<aa>\<bb>\<gg>\<ff>.NTDom.HomCod.cat_in_Obj_in_Vset
	+ intro: cat_cs_intros cat_lim_cs_intros
	+ )
	+
	+ from q_is_arr have \<aa>_q:
	+ "incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<aa>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cat_Set_components(1)
	+ cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	+ )
	+ interpret arr_Set \<alpha> \<open>incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q\<close>
	+ using \<aa>_q by (auto dest: cat_Set_is_arrD)
	+
	+ show "u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q"
	+ proof(rule ntcf_eqI)
	+ from q_is_arr show
	+ "ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q :
	+ cf_const ?II (cat_Set \<alpha>) r' \<mapsto>\<^sub>C\<^sub>F
	+ ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	+ from q_is_arr have dom_rhs:
	+ "\<D>\<^sub>\<circ>
	+ (
	+ (ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	+ ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
	+ by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ show "u'\<lparr>NTMap\<rparr> =
	+ (
	+ ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ show "vsv ((
	+ ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>)"
	+ by (cs_concl cs_intro: cat_cs_intros)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
	+ have [symmetric, cat_Set_cs_simps]:
	+ "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ from u'_\<aa>\<^sub>P\<^sub>L_is_arr have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>) = r'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ from \<aa>_q have dom_rhs:
	+ "\<D>\<^sub>\<circ> ((incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>) = r'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros
	+ )
	+ show "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr> =
	+ (incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix a assume prems: "a \<in>\<^sub>\<circ> r'"
	+ with u'_NTMap_vrange dom_lhs u'_\<aa>\<^sub>P\<^sub>L.ArrVal.vsv_vimageI2 have
	+ "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> vequalizer \<aa> \<gg> \<ff>"
	+ by blast
	+ with prems q_is_arr u'_\<aa>\<^sub>P\<^sub>L_is_arr show
	+ "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
	+ (incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> q)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_Set_cs_simps cat_cs_simps
	+ cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	+ )
	+ qed auto
	+ qed
	+ (
	+ use u'_\<aa>\<^sub>P\<^sub>L \<aa>_q in \<open>
	+ cs_concl cs_shallow
	+ cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
	+ \<close>
	+ )+
	+ from q_is_arr have u'_NTMap_app_I: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> =
	+ (
	+ ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
	+ )
	+ from q_is_arr assms have u'_NTMap_app_sI: "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr> =
	+ (
	+ ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<^sub>2\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_Set_cs_simps cat_cs_simps u'_\<gg>u'
	+ cs_intro:
	+ V_cs_intros
	+ cat_cs_intros
	+ cat_Set_cs_intros
	+ cat_parallel_cs_intros
	+ )
	+ from prems consider \<open>a = \<aa>\<^sub>P\<^sub>L\<^sub>2\<close> \| \<open>a = \<bb>\<^sub>P\<^sub>L\<^sub>2\<close>
	+ by (elim the_cat_parallel_2_ObjE)
	+ then show
	+ "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
	+ (
	+ ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	+ ntcf_const ?II (cat_Set \<alpha>) q
	+ )\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	+ by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
	+ qed auto
	+ qed (simp_all add: u'.is_ntcf_axioms)
	+
	+ fix f' assume prems:
	+ "f' : r' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> vequalizer \<aa> \<gg> \<ff>"
	+ "u' = ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II (cat_Set \<alpha>) f'"
	+ from prems(2) have u'_NTMap_app:
	+ "u'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> =
	+ (ntcf_Set_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
	+ ntcf_const ?II (cat_Set \<alpha>) f')\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
	+ for x
	+ by simp
	+ have u'_f':
	+ "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<^sub>2\<rparr> = incl_Set (vequalizer \<aa> \<gg> \<ff>) \<aa> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> f'"
	+ using u'_NTMap_app[of \<aa>\<^sub>P\<^sub>L\<^sub>2] prems(1)
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps
	+ cs_intro: cat_cs_intros cat_parallel_cs_intros
	+ )
	+ (
	+ cs_prems cs_shallow
	+ cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros
	+ )
	+
	+ note f' = cat_Set_is_arrD[OF prems(1)]
	+ note q = cat_Set_is_arrD[OF q_is_arr]
	+
	+ interpret f': arr_Set \<alpha> f' using prems(1) by (auto dest: cat_Set_is_arrD)
	+ interpret q: arr_Set \<alpha> q using q by (auto dest: cat_Set_is_arrD)
	+
	+ show "f' = q"
	+ proof(rule arr_Set_eqI[of \<alpha>])
	+ have dom_lhs: "\<D>\<^sub>\<circ> (f'\<lparr>ArrVal\<rparr>) = r'" by (simp add: cat_Set_cs_simps f')
	+ from q_is_arr have dom_rhs: "\<D>\<^sub>\<circ> (q\<lparr>ArrVal\<rparr>) = r'"
	+ by
	+ (
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros
	+ )
	+ show "f'\<lparr>ArrVal\<rparr> = q\<lparr>ArrVal\<rparr>"
	+ proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
	+ fix i assume "i \<in>\<^sub>\<circ> r'"
	+ with prems(1) show "f'\<lparr>ArrVal\<rparr>\<lparr>i\<rparr> = q\<lparr>ArrVal\<rparr>\<lparr>i\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp:
	+ cat_Set_cs_simps cat_cs_simps
	+ q_components u'_f' cat_Set_components(1)
	+ cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
	+ )
	+ qed auto
	+ qed
	+ (
	+ use prems(1) q_is_arr in \<open>
	+ cs_concl cs_shallow
	+ cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
	+ \<close>
	+ )+
	+ qed
	+ qed
	+
	+qed (auto intro: assms)
	+
	+
	+
	+subsection\<open>The category \<open>Set\<close> is small-complete\<close>
	+
	+lemma (in \<Z>) cat_small_complete_cat_Set: "cat_small_complete \<alpha> (cat_Set \<alpha>)"
	+ \<comment>\<open>This lemma appears as a remark on page 113 in
	+\cite{mac_lane_categories_2010}.\<close>
	+proof(rule category.cat_small_complete_if_eq_and_obj_prod)
	+ show "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ if "\<ff> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" and "\<gg> : \<aa> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<bb>" for \<aa> \<bb> \<gg> \<ff>
	+ using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
	+ show "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	+ if "tm_cf_discrete \<alpha> I A (cat_Set \<alpha>)" for A I
	+ proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
	+ interpret tm_cf_discrete \<alpha> I A \<open>cat_Set \<alpha>\<close> by (rule that)
	+ show "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>" by (rule tm_cf_discrete_ObjMap_in_Vset)
	+ qed
	+qed (rule category_cat_Set)
	+
	+text\<open>\newpage\<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Universal.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Universal.thy
	--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Universal.thy
	+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Universal.thy
	@@ -1,1147 +1,1248 @@
	(* Copyright 2021 (C) Mihails Milehins *)

	section\<open>Universal arrow\<close>
	theory CZH_UCAT_Universal
	imports
	CZH_UCAT_Introduction
	CZH_Elementary_Categories.CZH_ECAT_FUNCT
	- CZH_Elementary_Categories.CZH_ECAT_Set
	CZH_Elementary_Categories.CZH_ECAT_Hom
	begin



	subsection\<open>Background\<close>


	text\<open>
	The following section is based, primarily, on the elements of the content
	of Chapter III-1 in \cite{mac_lane_categories_2010}.
	\<close>

	+named_theorems ua_field_simps
	+
	+definition UObj :: V where [ua_field_simps]: "UObj = 0"
	+definition UArr :: V where [ua_field_simps]: "UArr = 1\<^sub>\<nat>"
	+
	+lemma [cat_cs_simps]:
	+ shows UObj_simp: "[a, b]\<^sub>\<circ>\<lparr>UObj\<rparr> = a"
	+ and UArr_simp: "[a, b]\<^sub>\<circ>\<lparr>UArr\<rparr> = b"
	+ unfolding ua_field_simps by (simp_all add: nat_omega_simps)
	+


	subsection\<open>Universal map\<close>


	text\<open>
	The universal map is a convenience utility that allows treating
	a part of the definition of the universal arrow as an arrow in the
	category \<open>Set\<close>.
	\<close>


	subsubsection\<open>Definition and elementary properties\<close>

	definition umap_of :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "umap_of \<FF> c r u d =
	[
	(\<lambda>f'\<in>\<^sub>\<circ>Hom (\<FF>\<lparr>HomDom\<rparr>) r d. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> u),
	Hom (\<FF>\<lparr>HomDom\<rparr>) r d,
	Hom (\<FF>\<lparr>HomCod\<rparr>) c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)
	]\<^sub>\<circ>"

	definition umap_fo :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "umap_fo \<FF> c r u d = umap_of (op_cf \<FF>) c r u d"


	text\<open>Components.\<close>

	lemma (in is_functor) umap_of_components:
	assumes "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>" (do not remove)
	shows "umap_of \<FF> c r u d\<lparr>ArrVal\<rparr> = (\<lambda>f'\<in>\<^sub>\<circ>Hom \<AA> r d. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u)"
	and "umap_of \<FF> c r u d\<lparr>ArrDom\<rparr> = Hom \<AA> r d"
	and "umap_of \<FF> c r u d\<lparr>ArrCod\<rparr> = Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)"
	unfolding umap_of_def arr_field_simps
	by (simp_all add: cat_cs_simps nat_omega_simps)

	lemma (in is_functor) umap_fo_components:
	assumes "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "umap_fo \<FF> c r u d\<lparr>ArrVal\<rparr> = (\<lambda>f'\<in>\<^sub>\<circ>Hom \<AA> d r. u \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>)"
	and "umap_fo \<FF> c r u d\<lparr>ArrDom\<rparr> = Hom \<AA> d r"
	and "umap_fo \<FF> c r u d\<lparr>ArrCod\<rparr> = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) c"
	unfolding
	umap_fo_def
	is_functor.umap_of_components[
	OF is_functor_op, unfolded cat_op_simps, OF assms
	]
	proof(rule vsv_eqI)
	fix f' assume "f' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<lambda>f'\<in>\<^sub>\<circ>Hom \<AA> d r. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<BB>\<^esub> u)"
	then have f': "f' : d \<mapsto>\<^bsub>\<AA>\<^esub> r" by simp
	then have \<FF>f': "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by (auto intro: cat_cs_intros)
	from f' show
	"(\<lambda>f'\<in>\<^sub>\<circ>Hom \<AA> d r. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<BB>\<^esub> u)\<lparr>f'\<rparr> =
	(\<lambda>f'\<in>\<^sub>\<circ>Hom \<AA> d r. u \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>)\<lparr>f'\<rparr>"
	by (simp add: HomCod.op_cat_Comp[OF assms \<FF>f'])
	qed simp_all


	text\<open>Universal maps for the opposite functor.\<close>

	lemma (in is_functor) op_umap_of[cat_op_simps]: "umap_of (op_cf \<FF>) = umap_fo \<FF>"
	unfolding umap_fo_def by simp

	lemma (in is_functor) op_umap_fo[cat_op_simps]: "umap_fo (op_cf \<FF>) = umap_of \<FF>"
	unfolding umap_fo_def by (simp add: cat_op_simps)

	lemmas [cat_op_simps] =
	is_functor.op_umap_of
	is_functor.op_umap_fo


	subsubsection\<open>Arrow value\<close>

	lemma umap_of_ArrVal_vsv[cat_cs_intros]: "vsv (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>)"
	unfolding umap_of_def arr_field_simps by (simp add: nat_omega_simps)

	lemma umap_fo_ArrVal_vsv[cat_cs_intros]: "vsv (umap_fo \<FF> c r u d\<lparr>ArrVal\<rparr>)"
	unfolding umap_fo_def by (rule umap_of_ArrVal_vsv)

	lemma (in is_functor) umap_of_ArrVal_vdomain:
	assumes "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "\<D>\<^sub>\<circ> (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>) = Hom \<AA> r d"
	unfolding umap_of_components[OF assms] by simp

	lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_vdomain

	lemma (in is_functor) umap_fo_ArrVal_vdomain:
	assumes "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "\<D>\<^sub>\<circ> (umap_fo \<FF> c r u d\<lparr>ArrVal\<rparr>) = Hom \<AA> d r"
	unfolding umap_fo_components[OF assms] by simp

	lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_vdomain

	lemma (in is_functor) umap_of_ArrVal_app:
	assumes "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> d" and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	using assms(1) unfolding umap_of_components[OF assms(2)] by simp

	lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_app

	lemma (in is_functor) umap_fo_ArrVal_app:
	assumes "f' : d \<mapsto>\<^bsub>\<AA>\<^esub> r" and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "umap_fo \<FF> c r u d\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> = u \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	proof-
	from assms have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by (auto intro: cat_cs_intros)
	from this assms(2) have \<FF>f'[simp]:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<BB>\<^esub> u = u \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
	by (simp add: cat_op_simps)
	from
	is_functor_axioms
	is_functor.umap_of_ArrVal_app[
	OF is_functor_op, unfolded cat_op_simps,
	OF assms
	]
	show ?thesis
	by (simp add: cat_op_simps cat_cs_simps)
	qed

	lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_app

	lemma (in is_functor) umap_of_ArrVal_vrange:
	assumes "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "\<R>\<^sub>\<circ> (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)"
	proof(intro vsubset_antisym vsubsetI)
	interpret vsv \<open>umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>\<close>
	unfolding umap_of_components[OF assms] by simp
	fix g assume "g \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>)"
	then obtain f'
	where g_def: "g = umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and f': "f' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>)"
	unfolding umap_of_components[OF assms] by auto
	then have f': "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> d"
	unfolding umap_of_ArrVal_vdomain[OF assms] by simp
	then have \<FF>f': "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
	by (auto intro!: cat_cs_intros)
	have g_def: "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	unfolding g_def umap_of_ArrVal_app[OF f' assms]..
	from \<FF>f' assms show "g \<in>\<^sub>\<circ> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)"
	unfolding g_def by (auto intro: cat_cs_intros)
	qed

	lemma (in is_functor) umap_fo_ArrVal_vrange:
	assumes "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "\<R>\<^sub>\<circ> (umap_fo \<FF> c r u d\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) c"
	by
	(
	rule is_functor.umap_of_ArrVal_vrange[
	OF is_functor_op, unfolded cat_op_simps, OF assms, folded umap_fo_def
	]
	)


	subsubsection\<open>Universal map is an arrow in the category \<open>Set\<close>\<close>

	lemma (in is_functor) cf_arr_Set_umap_of:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and d: "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and u: "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "arr_Set \<alpha> (umap_of \<FF> c r u d)"
	proof(intro arr_SetI)
	interpret HomDom: category \<alpha> \<AA> by (rule assms(1))
	interpret HomCod: category \<alpha> \<BB> by (rule assms(2))
	note umap_of_components = umap_of_components[OF u]
	from u d have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and \<FF>d: "(\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by (auto intro: cat_cs_intros)
	show "vfsequence (umap_of \<FF> c r u d)" unfolding umap_of_def by simp
	show "vcard (umap_of \<FF> c r u d) = 3\<^sub>\<nat>"
	unfolding umap_of_def by (simp add: nat_omega_simps)
	from umap_of_ArrVal_vrange[OF u] show
	"\<R>\<^sub>\<circ> (umap_of \<FF> c r u d\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> umap_of \<FF> c r u d\<lparr>ArrCod\<rparr>"
	unfolding umap_of_components by simp
	from r d show "umap_of \<FF> c r u d\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding umap_of_components by (intro HomDom.cat_Hom_in_Vset)
	from c \<FF>d show "umap_of \<FF> c r u d\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
	unfolding umap_of_components by (intro HomCod.cat_Hom_in_Vset)
	qed (auto simp: umap_of_components[OF u])

	lemma (in is_functor) cf_arr_Set_umap_fo:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and d: "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and u: "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "arr_Set \<alpha> (umap_fo \<FF> c r u d)"
	proof-
	from assms(1) have \<AA>: "category \<alpha> (op_cat \<AA>)"
	by (auto intro: cat_cs_intros)
	from assms(2) have \<BB>: "category \<alpha> (op_cat \<BB>)"
	by (auto intro: cat_cs_intros)
	show ?thesis
	by
	(
	rule
	is_functor.cf_arr_Set_umap_of[
	OF is_functor_op, unfolded cat_op_simps, OF \<AA> \<BB> r d u
	]
	)
	qed

	lemma (in is_functor) cf_umap_of_is_arr:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "umap_of \<FF> c r u d : Hom \<AA> r d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)"
	proof(intro cat_Set_is_arrI)
	show "arr_Set \<alpha> (umap_of \<FF> c r u d)"
	by (rule cf_arr_Set_umap_of[OF assms])
	qed (simp_all add: umap_of_components[OF assms(5)])

	lemma (in is_functor) cf_umap_of_is_arr':
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "A = Hom \<AA> r d"
	and "B = Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>)"
	and "\<CC> = cat_Set \<alpha>"
	shows "umap_of \<FF> c r u d : A \<mapsto>\<^bsub>\<CC>\<^esub> B"
	using assms(1-5) unfolding assms(6-8) by (rule cf_umap_of_is_arr)

	lemmas [cat_cs_intros] = is_functor.cf_umap_of_is_arr'

	lemma (in is_functor) cf_umap_fo_is_arr:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "umap_fo \<FF> c r u d : Hom \<AA> d r \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) c"
	proof(intro cat_Set_is_arrI)
	show "arr_Set \<alpha> (umap_fo \<FF> c r u d)"
	by (rule cf_arr_Set_umap_fo[OF assms])
	qed (simp_all add: umap_fo_components[OF assms(5)])

	lemma (in is_functor) cf_umap_fo_is_arr':
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and "A = Hom \<AA> d r"
	and "B = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>) c"
	and "\<CC> = cat_Set \<alpha>"
	shows "umap_fo \<FF> c r u d : A \<mapsto>\<^bsub>\<CC>\<^esub> B"
	using assms(1-5) unfolding assms(6-8) by (rule cf_umap_fo_is_arr)

	lemmas [cat_cs_intros] = is_functor.cf_umap_fo_is_arr'



	subsection\<open>Universal arrow: definition and elementary properties\<close>


	text\<open>See Chapter III-1 in \cite{mac_lane_categories_2010}.\<close>

	definition universal_arrow_of :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "universal_arrow_of \<FF> c r u \<longleftrightarrow>
	(
	r \<in>\<^sub>\<circ> \<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
	u : c \<mapsto>\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<and>
	(
	\<forall>r' u'.
	r' \<in>\<^sub>\<circ> \<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<longrightarrow>
	u' : c \<mapsto>\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<longrightarrow>
	(\<exists>!f'. f' : r \<mapsto>\<^bsub>\<FF>\<lparr>HomDom\<rparr>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>)
	)
	)"

	definition universal_arrow_fo :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
	where "universal_arrow_fo \<FF> c r u \<equiv> universal_arrow_of (op_cf \<FF>) c r u"


	text\<open>Rules.\<close>

	mk_ide (in is_functor) rf
	universal_arrow_of_def[where \<FF>=\<FF>, unfolded cf_HomDom cf_HomCod]
	\|intro universal_arrow_ofI\|
	\|dest universal_arrow_ofD[dest]\|
	\|elim universal_arrow_ofE[elim]\|

	lemma (in is_functor) universal_arrow_foI:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and "\<And>r' u'. \<lbrakk> r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; u' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c \<rbrakk> \<Longrightarrow>
	\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r \<and> u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	shows "universal_arrow_fo \<FF> c r u"
	by
	(
	simp add:
	is_functor.universal_arrow_ofI
	[
	OF is_functor_op,
	folded universal_arrow_fo_def,
	unfolded cat_op_simps,
	OF assms
	]
	)

	lemma (in is_functor) universal_arrow_foD[dest]:
	assumes "universal_arrow_fo \<FF> c r u"
	shows "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and "\<And>r' u'. \<lbrakk> r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; u' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c \<rbrakk> \<Longrightarrow>
	\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r \<and> u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	by
	(
	auto simp:
	is_functor.universal_arrow_ofD
	[
	OF is_functor_op,
	folded universal_arrow_fo_def,
	unfolded cat_op_simps,
	OF assms
	]
	)

	lemma (in is_functor) universal_arrow_foE[elim]:
	assumes "universal_arrow_fo \<FF> c r u"
	obtains "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and "\<And>r' u'. \<lbrakk> r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; u' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c \<rbrakk> \<Longrightarrow>
	\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r \<and> u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	using assms by (auto simp: universal_arrow_foD)


	text\<open>Elementary properties.\<close>

	lemma (in is_functor) op_cf_universal_arrow_of[cat_op_simps]:
	"universal_arrow_of (op_cf \<FF>) c r u \<longleftrightarrow> universal_arrow_fo \<FF> c r u"
	unfolding universal_arrow_fo_def ..

	lemma (in is_functor) op_cf_universal_arrow_fo[cat_op_simps]:
	"universal_arrow_fo (op_cf \<FF>) c r u \<longleftrightarrow> universal_arrow_of \<FF> c r u"
	unfolding universal_arrow_fo_def cat_op_simps ..

	lemmas (in is_functor) [cat_op_simps] =
	is_functor.op_cf_universal_arrow_of
	is_functor.op_cf_universal_arrow_fo



	subsection\<open>Uniqueness\<close>


	text\<open>
	The following properties are related to the uniqueness of the
	universal arrow. These properties can be inferred from the content of
	Chapter III-1 in \cite{mac_lane_categories_2010}.
	\<close>

	-lemma (in is_functor) cf_universal_arrow_of_ex_is_arr_isomorphism:
	+lemma (in is_functor) cf_universal_arrow_of_ex_is_iso_arr:
	\<comment>\<open>The proof is based on the ideas expressed in the proof of Theorem 5.2
	in Chapter Introduction in \cite{hungerford_algebra_2003}.\<close>
	assumes "universal_arrow_of \<FF> c r u" and "universal_arrow_of \<FF> c r' u'"
	obtains f where "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r'" and "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	proof-

	note ua1 = universal_arrow_ofD[OF assms(1)]
	note ua2 = universal_arrow_ofD[OF assms(2)]

	from ua1(1) have \<AA>r: "\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr> : r \<mapsto>\<^bsub>\<AA>\<^esub> r" by (auto intro: cat_cs_intros)
	from ua1(1) have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>\<rparr>"
	by (auto intro: cat_cs_intros)
	with ua1(1,2) have u_def: "u = umap_of \<FF> c r u r\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	unfolding umap_of_ArrVal_app[OF \<AA>r ua1(2)] by (auto simp: cat_cs_simps)

	from ua2(1) have \<AA>r': "\<AA>\<lparr>CId\<rparr>\<lparr>r'\<rparr> : r' \<mapsto>\<^bsub>\<AA>\<^esub> r'" by (auto intro: cat_cs_intros)
	from ua2(1) have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r'\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>\<rparr>"
	by (auto intro: cat_cs_intros)
	with ua2(1,2) have u'_def: "u' = umap_of \<FF> c r' u' r'\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r'\<rparr>\<rparr>"
	unfolding umap_of_ArrVal_app[OF \<AA>r' ua2(2)] by (auto simp: cat_cs_simps)

	from \<AA>r u_def universal_arrow_ofD(3)[OF assms(1) ua1(1,2)] have eq_CId_rI:
	"\<lbrakk> f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r; u = umap_of \<FF> c r u r\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> \<rbrakk> \<Longrightarrow> f' = \<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
	for f'
	by blast
	from \<AA>r' u'_def universal_arrow_ofD(3)[OF assms(2) ua2(1,2)] have eq_CId_r'I:
	"\<lbrakk> f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r'; u' = umap_of \<FF> c r' u' r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> \<rbrakk> \<Longrightarrow>
	f' = \<AA>\<lparr>CId\<rparr>\<lparr>r'\<rparr>"
	for f'
	by blast

	from ua1(3)[OF ua2(1,2)] obtain f
	where f: "f : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	and u'_def: "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	and "g : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<Longrightarrow> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> \<Longrightarrow> f = g"
	for g
	by metis
	from ua2(3)[OF ua1(1,2)] obtain f'
	where f': "f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r"
	and u_def: "u = umap_of \<FF> c r' u' r\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	and "g : r' \<mapsto>\<^bsub>\<AA>\<^esub> r \<Longrightarrow> u = umap_of \<FF> c r' u' r\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> \<Longrightarrow> f' = g"
	for g
	by metis

	have "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r'"
	- proof(intro is_arr_isomorphismI is_inverseI)
	+ proof(intro is_iso_arrI is_inverseI)
	show f: "f : r \<mapsto>\<^bsub>\<AA>\<^esub> r'" by (rule f)
	show f': "f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r" by (rule f')
	show "f : r \<mapsto>\<^bsub>\<AA>\<^esub> r'" by (rule f)
	from f' have \<FF>f': "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by (auto intro: cat_cs_intros)
	from f have \<FF>f: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	by (auto intro: cat_cs_intros)
	note u'_def' = u'_def[symmetric, unfolded umap_of_ArrVal_app[OF f ua1(2)]]
	and u_def' = u_def[symmetric, unfolded umap_of_ArrVal_app[OF f' ua2(2)]]
	show "f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f = \<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
	proof(rule eq_CId_rI)
	from f f' show f'f: "f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f : r \<mapsto>\<^bsub>\<AA>\<^esub> r"
	by (auto intro: cat_cs_intros)
	from ua1(2) \<FF>f' \<FF>f show "u = umap_of \<FF> c r u r\<lparr>ArrVal\<rparr>\<lparr>f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr>"
	unfolding umap_of_ArrVal_app[OF f'f ua1(2)] cf_ArrMap_Comp[OF f' f]
	by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
	qed
	show "f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f' = \<AA>\<lparr>CId\<rparr>\<lparr>r'\<rparr>"
	proof(rule eq_CId_r'I)
	from f f' show ff': "f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	by (auto intro: cat_cs_intros)
	from ua2(2) \<FF>f' \<FF>f show "u' = umap_of \<FF> c r' u' r'\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f'\<rparr>"
	unfolding umap_of_ArrVal_app[OF ff' ua2(2)] cf_ArrMap_Comp[OF f f']
	by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
	qed
	qed

	with u'_def that show ?thesis by auto

	qed

	-lemma (in is_functor) cf_universal_arrow_fo_ex_is_arr_isomorphism:
	+lemma (in is_functor) cf_universal_arrow_fo_ex_is_iso_arr:
	assumes "universal_arrow_fo \<FF> c r u"
	and "universal_arrow_fo \<FF> c r' u'"
	obtains f where "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r" and "u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by
	(
	elim
	- is_functor.cf_universal_arrow_of_ex_is_arr_isomorphism[
	+ is_functor.cf_universal_arrow_of_ex_is_iso_arr[
	OF is_functor_op, unfolded cat_op_simps, OF assms
	]
	)

	lemma (in is_functor) cf_universal_arrow_of_unique:
	assumes "universal_arrow_of \<FF> c r u"
	and "universal_arrow_of \<FF> c r' u'"
	shows "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof-
	note ua1 = universal_arrow_ofD[OF assms(1)]
	note ua2 = universal_arrow_ofD[OF assms(2)]
	from ua1(3)[OF ua2(1,2)] show ?thesis .
	qed

	lemma (in is_functor) cf_universal_arrow_fo_unique:
	assumes "universal_arrow_fo \<FF> c r u"
	and "universal_arrow_fo \<FF> c r' u'"
	shows "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r \<and> u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof-
	note ua1 = universal_arrow_foD[OF assms(1)]
	note ua2 = universal_arrow_foD[OF assms(2)]
	from ua1(3)[OF ua2(1,2)] show ?thesis .
	qed

	-lemma (in is_functor) cf_universal_arrow_of_is_arr_isomorphism:
	+lemma (in is_functor) cf_universal_arrow_of_is_iso_arr:
	assumes "universal_arrow_of \<FF> c r u"
	and "universal_arrow_of \<FF> c r' u'"
	and "f : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	and "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	shows "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r'"
	proof-
	from assms(3,4) cf_universal_arrow_of_unique[OF assms(1,2)] have eq:
	"g : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<Longrightarrow> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> \<Longrightarrow> f = g" for g
	by blast
	from assms(1,2) obtain f'
	where iso_f': "f' : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r'"
	and u'_def: "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	- by (auto elim: cf_universal_arrow_of_ex_is_arr_isomorphism)
	+ by (auto elim: cf_universal_arrow_of_ex_is_iso_arr)
	then have f': "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'" by auto
	from iso_f' show ?thesis unfolding eq[OF f' u'_def, symmetric].
	qed

	-lemma (in is_functor) cf_universal_arrow_fo_is_arr_isomorphism:
	+lemma (in is_functor) cf_universal_arrow_fo_is_iso_arr:
	assumes "universal_arrow_fo \<FF> c r u"
	and "universal_arrow_fo \<FF> c r' u'"
	and "f : r' \<mapsto>\<^bsub>\<AA>\<^esub> r"
	and "u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	shows "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r"
	by
	(
	rule
	- is_functor.cf_universal_arrow_of_is_arr_isomorphism[
	+ is_functor.cf_universal_arrow_of_is_iso_arr[
	OF is_functor_op, unfolded cat_op_simps, OF assms
	]
	)

	+lemma (in is_functor) universal_arrow_of_if_universal_arrow_of:
	+ assumes "universal_arrow_of \<FF> c r u"
	+ and "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r'"
	+ and "u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ shows "universal_arrow_of \<FF> c r' u'"
	+proof(intro universal_arrow_ofI assms(2))
	+
	+ note ua = universal_arrow_ofD[OF assms(1)]
	+ note f = is_iso_arrD(1)[OF assms(2)]
	+ from assms(3) ua(1,2) f have u'_def: "u' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from ua(2) f show u': "u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	+ unfolding u'_def by (cs_concl cs_intro: cat_cs_intros)
	+
	+ from f(1) show "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
	+
	+ fix r'' u'' assume prems: "r'' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "u'' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r''\<rparr>"
	+
	+ from ua(3)[OF prems] obtain f'
	+ where f': "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r''"
	+ and u''_def: "u'' = umap_of \<FF> c r u r''\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ and f'_unique: "\<And>f''.
	+ \<lbrakk> f'' : r \<mapsto>\<^bsub>\<AA>\<^esub> r''; u'' = umap_of \<FF> c r u r''\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr> \<rbrakk> \<Longrightarrow>
	+ f'' = f'"
	+ by metis
	+
	+ from u''_def f' ua(2) have [cat_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u = u''"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) simp
	+
	+ show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> r'' \<and> u'' = umap_of \<FF> c r' u' r''\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	+ proof(intro ex1I conjI; (elim conjE)?)
	+ from f' assms(2) f show "f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub> : r' \<mapsto>\<^bsub>\<AA>\<^esub> r''"
	+ by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros)
	+ have
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u') =
	+ \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u))"
	+ unfolding u'_def ..
	+ also from f' assms(2) u' f ua(2) have
	+ "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
	+ )
	+ also from f' assms(2) f ua(2) have "\<dots> = u''"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ finally have [cat_cs_simps]:
	+ "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u') = u''".
	+ from f' assms(2) u' f show
	+ "u'' = umap_of \<FF> c r' u' r''\<lparr>ArrVal\<rparr>\<lparr>f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>\<rparr>"
	+ by
	+ (
	+ cs_concl
	+ cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
	+ )
	+ fix g assume prems':
	+ "g : r' \<mapsto>\<^bsub>\<AA>\<^esub> r''" "u'' = umap_of \<FF> c r' u' r''\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
	+ from prems'(1) f have gf: "g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f : r \<mapsto>\<^bsub>\<AA>\<^esub> r''"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ from prems'(2,1) assms(2) u' have "u'' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u'"
	+ by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ also from prems'(1) f ua(2) have
	+ "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u"
	+ by (cs_concl cs_simp: cat_cs_simps u'_def u''_def cs_intro: cat_cs_intros)
	+ also from prems'(1) f ua(2) have
	+ "\<dots> = umap_of \<FF> c r u r''\<lparr>ArrVal\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr>"
	+ by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	+ finally have "u'' = umap_of \<FF> c r u r''\<lparr>ArrVal\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr>".
	+ from f'_unique[OF gf this] have "g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f = f'".
	+ then have "(g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f) \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub> = f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>" by simp
	+ from this assms(2) prems'(1) u' f ua(2) show "g = f' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<inverse>\<^sub>C\<^bsub>\<AA>\<^esub>"
	+ by
	+ (
	+ cs_prems
	+ cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
	+ )
	+ qed
	+
	+qed
	+
	+lemma (in is_functor) universal_arrow_fo_if_universal_arrow_fo:
	+ assumes "universal_arrow_fo \<FF> c r u"
	+ and "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<AA>\<^esub> r"
	+ and "u' = umap_fo \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	+ shows "universal_arrow_fo \<FF> c r' u'"
	+ by
	+ (
	+ rule is_functor.universal_arrow_of_if_universal_arrow_of[
	+ OF is_functor_op, unfolded cat_op_simps, OF assms
	+ ]
	+ )
	+


	subsection\<open>Universal natural transformation\<close>


	subsubsection\<open>Definition and elementary properties\<close>


	text\<open>
	The concept of the universal natural transformation is introduced for the
	statement of the elements of a variant of Proposition 1 in Chapter III-2
	in \cite{mac_lane_categories_2010}.
	\<close>

	definition ntcf_ua_of :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_ua_of \<alpha> \<FF> c r u =
	[
	(\<lambda>d\<in>\<^sub>\<circ>\<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. umap_of \<FF> c r u d),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomDom\<rparr>(r,-),
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>,
	\<FF>\<lparr>HomDom\<rparr>,
	cat_Set \<alpha>
	]\<^sub>\<circ>"

	definition ntcf_ua_fo :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
	where "ntcf_ua_fo \<alpha> \<FF> c r u = ntcf_ua_of \<alpha> (op_cf \<FF>) c r u"


	text\<open>Components.\<close>

	lemma ntcf_ua_of_components:
	shows "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr> = (\<lambda>d\<in>\<^sub>\<circ>\<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. umap_of \<FF> c r u d)"
	and "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomDom\<rparr>(r,-)"
	and "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>"
	and "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTDGDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
	and "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding ntcf_ua_of_def nt_field_simps by (simp_all add: nat_omega_simps)

	lemma ntcf_ua_fo_components:
	shows "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTMap\<rparr> = (\<lambda>d\<in>\<^sub>\<circ>\<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. umap_fo \<FF> c r u d)"
	and "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat (\<FF>\<lparr>HomDom\<rparr>)(r,-)"
	and "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTCod\<rparr> =
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat (\<FF>\<lparr>HomCod\<rparr>)(c,-) \<circ>\<^sub>C\<^sub>F op_cf \<FF>"
	and "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDGDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>)"
	and "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding ntcf_ua_fo_def ntcf_ua_of_components umap_fo_def cat_op_simps
	by simp_all

	context is_functor
	begin

	lemmas ntcf_ua_of_components' =
	ntcf_ua_of_components[where \<alpha>=\<alpha> and \<FF>=\<FF>, unfolded cat_cs_simps]

	lemmas [cat_cs_simps] = ntcf_ua_of_components'(2-5)

	lemma ntcf_ua_fo_components':
	assumes "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	shows "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTMap\<rparr> = (\<lambda>d\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. umap_fo \<FF> c r u d)"
	and [cat_cs_simps]:
	"ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,r)"
	and [cat_cs_simps]:
	"ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(-,c) \<circ>\<^sub>C\<^sub>F op_cf \<FF>"
	and [cat_cs_simps]: "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDGDom\<rparr> = op_cat \<AA>"
	and [cat_cs_simps]: "ntcf_ua_fo \<alpha> \<FF> c r u\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
	unfolding
	ntcf_ua_fo_components cat_cs_simps
	HomDom.cat_op_cat_cf_Hom_snd[OF assms(2)]
	HomCod.cat_op_cat_cf_Hom_snd[OF assms(1)]
	by simp_all

	end

	lemmas [cat_cs_simps] =
	is_functor.ntcf_ua_of_components'(2-5)
	is_functor.ntcf_ua_fo_components'(2-5)


	subsubsection\<open>Natural transformation map\<close>

	mk_VLambda (in is_functor)
	ntcf_ua_of_components(1)[where \<alpha>=\<alpha> and \<FF>=\<FF>, unfolded cf_HomDom]
	\|vsv ntcf_ua_of_NTMap_vsv\|
	\|vdomain ntcf_ua_of_NTMap_vdomain\|
	\|app ntcf_ua_of_NTMap_app\|

	context is_functor
	begin

	context
	fixes c r
	assumes r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	begin

	mk_VLambda ntcf_ua_fo_components'(1)[OF c r]
	\|vsv ntcf_ua_fo_NTMap_vsv\|
	\|vdomain ntcf_ua_fo_NTMap_vdomain\|
	\|app ntcf_ua_fo_NTMap_app\|

	end

	end

	lemmas [cat_cs_intros] =
	is_functor.ntcf_ua_fo_NTMap_vsv
	is_functor.ntcf_ua_of_NTMap_vsv

	lemmas [cat_cs_simps] =
	is_functor.ntcf_ua_fo_NTMap_vdomain
	is_functor.ntcf_ua_fo_NTMap_app
	is_functor.ntcf_ua_of_NTMap_vdomain
	is_functor.ntcf_ua_of_NTMap_app

	lemma (in is_functor) ntcf_ua_of_NTMap_vrange:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "\<R>\<^sub>\<circ> (ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	proof(rule vsv.vsv_vrange_vsubset, unfold ntcf_ua_of_NTMap_vdomain)
	show "vsv (ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr>)" by (rule ntcf_ua_of_NTMap_vsv)
	fix d assume prems: "d \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	with category_cat_Set is_functor_axioms assms show
	"ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	qed


	subsubsection\<open>Commutativity of the universal maps and \<open>hom\<close>-functions\<close>

	lemma (in is_functor) cf_umap_of_cf_hom_commute:
	assumes "category \<alpha> \<AA>"
	and "category \<alpha> \<BB>"
	and "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
	shows
	"umap_of \<FF> c r u b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ> =
	cf_hom \<BB> [\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> umap_of \<FF> c r u a"
	(is \<open>?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf = ?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a\<close>)
	proof-

	from is_functor_axioms category_cat_Set assms(1,2,4-6) have b_rf:
	"?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf : Hom \<AA> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by
	(
	cs_concl cs_shallow
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	from is_functor_axioms category_cat_Set assms(1,2,4-6) have cf_a:
	"?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a : Hom \<AA> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
	by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from b_rf show arr_Set_b_rf: "arr_Set \<alpha> (?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf)"
	by (auto dest: cat_Set_is_arrD(1))
	from b_rf have dom_lhs:
	"\<D>\<^sub>\<circ> ((?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf)\<lparr>ArrVal\<rparr>) = Hom \<AA> r a"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
	from cf_a show arr_Set_cf_a: "arr_Set \<alpha> (?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a)"
	by (auto dest: cat_Set_is_arrD(1))
	from cf_a have dom_rhs:
	"\<D>\<^sub>\<circ> ((?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a)\<lparr>ArrVal\<rparr>) = Hom \<AA> r a"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "(?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf)\<lparr>ArrVal\<rparr> = (?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix q assume "q : r \<mapsto>\<^bsub>\<AA>\<^esub> a"
	with is_functor_axioms category_cat_Set assms show
	"(?uof_b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?rf)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> =
	(?cf \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_a)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr>"
	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_rf arr_Set_cf_a in auto)

	qed (use b_rf cf_a in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed

	lemma cf_umap_of_cf_hom_unit_commute:
	assumes "category \<alpha> \<CC>"
	and "category \<alpha> \<DD>"
	and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
	and "\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "\<eta> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
	and "g : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
	and "f : d \<mapsto>\<^bsub>\<DD>\<^esub> d'"
	shows
	"umap_of \<GG> c' (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr>) d' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_hom \<DD> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, f]\<^sub>\<circ> =
	cf_hom \<CC> [g, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	umap_of \<GG> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) (\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>) d"
	(is \<open>?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf = ?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd\<close>)
	proof-

	interpret \<eta>: is_ntcf \<alpha> \<CC> \<CC> \<open>cf_id \<CC>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<eta> by (rule assms(5))

	from assms have c'd'_\<FF>gf: "?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> c' (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d'\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	then have dom_lhs:
	"\<D>\<^sub>\<circ> ((?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf)\<lparr>ArrVal\<rparr>) = Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) d"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	from assms have g\<GG>f_cd: "?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd :
	Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> c' (\<GG>\<lparr>ObjMap\<rparr>\<lparr>d'\<rparr>)"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	)
	then have dom_rhs:
	"\<D>\<^sub>\<circ> ((?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd)\<lparr>ArrVal\<rparr>) = Hom \<DD> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>) d"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)

	show ?thesis
	proof(rule arr_Set_eqI[of \<alpha>])
	from c'd'_\<FF>gf show arr_Set_c'd'_\<FF>gf:
	"arr_Set \<alpha> (?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf)"
	by (auto dest: cat_Set_is_arrD(1))
	from g\<GG>f_cd show arr_Set_g\<GG>f_cd:
	"arr_Set \<alpha> (?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd)"
	by (auto dest: cat_Set_is_arrD(1))
	show
	"(?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf)\<lparr>ArrVal\<rparr> =
	(?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd)\<lparr>ArrVal\<rparr>"
	proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
	fix h assume prems: "h : \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> d"
	from \<eta>.ntcf_Comp_commute[OF assms(6)] assms have [cat_cs_simps]:
	"\<eta>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<eta>\<lparr>NTMap\<rparr>\<lparr>c'\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	from assms prems show
	"(?uof_c'd' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<FF>gf)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> =
	(?g\<GG>f \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?uof_cd)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
	by
	(
	cs_concl
	cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
	cs_simp: cat_cs_simps
	)
	qed (use arr_Set_c'd'_\<FF>gf arr_Set_g\<GG>f_cd in auto)

	qed (use c'd'_\<FF>gf g\<GG>f_cd in \<open>cs_concl cs_shallow cs_simp: cat_cs_simps\<close>)+

	qed


	subsubsection\<open>Universal natural transformation is a natural transformation\<close>

	lemma (in is_functor) cf_ntcf_ua_of_is_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	shows "ntcf_ua_of \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof(intro is_ntcfI')
	let ?ua = \<open>ntcf_ua_of \<alpha> \<FF> c r u\<close>
	show "vfsequence (ntcf_ua_of \<alpha> \<FF> c r u)" unfolding ntcf_ua_of_def by simp
	show "vcard ?ua = 5\<^sub>\<nat>" unfolding ntcf_ua_of_def by (simp add: nat_omega_simps)
	from assms(1) show "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from is_functor_axioms assms(2) show
	"Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (cs_concl cs_intro: cat_cs_intros)
	from is_functor_axioms assms show "\<D>\<^sub>\<circ> (?ua\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps)
	show "?ua\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
	using is_functor_axioms assms that
	by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
	show "?ua\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?ua\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
	if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" for a b f
	using is_functor_axioms assms that
	by
	(
	cs_concl
	cs_simp: cf_umap_of_cf_hom_commute cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	qed (auto simp: ntcf_ua_of_components cat_cs_simps)

	lemma (in is_functor) cf_ntcf_ua_fo_is_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	shows "ntcf_ua_fo \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(-,c) \<circ>\<^sub>C\<^sub>F op_cf \<FF> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	from assms(2) have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	show ?thesis
	by
	(
	rule is_functor.cf_ntcf_ua_of_is_ntcf
	[
	OF is_functor_op,
	unfolded cat_op_simps,
	OF assms(1,2),
	unfolded
	HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
	HomCod.cat_op_cat_cf_Hom_snd[OF c]
	ntcf_ua_fo_def[symmetric]
	]
	)
	qed


	subsubsection\<open>Universal natural transformation and universal arrow\<close>


	text\<open>
	The lemmas in this subsection correspond to
	variants of elements of Proposition 1 in Chapter III-2 in
	\cite{mac_lane_categories_2010}.
	\<close>

	lemma (in is_functor) cf_ntcf_ua_of_is_iso_ntcf:
	assumes "universal_arrow_of \<FF> c r u"
	shows "ntcf_ua_of \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-

	have r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and u: "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and bij: "\<And>r' u'.
	\<lbrakk>
	r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>;
	u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>
	\<rbrakk> \<Longrightarrow> \<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	by (auto intro!: universal_arrow_ofD[OF assms(1)])

	show ?thesis
	proof(intro is_iso_ntcfI)
	show "ntcf_ua_of \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	by (rule cf_ntcf_ua_of_is_ntcf[OF r u])
	fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	from is_functor_axioms prems r u have [simp]:
	"umap_of \<FF> c r u a : Hom \<AA> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	then have dom: "\<D>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>) = Hom \<AA> r a"
	by (cs_concl cs_simp: cat_cs_simps)
	have "umap_of \<FF> c r u a : Hom \<AA> r a \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	- proof(intro cat_Set_is_arr_isomorphismI, unfold dom)
	+ proof(intro cat_Set_is_iso_arrI, unfold dom)

	show umof_a: "v11 (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>)"
	proof(intro vsv.vsv_valeq_v11I, unfold dom in_Hom_iff)
	fix g f assume prems':
	"g : r \<mapsto>\<^bsub>\<AA>\<^esub> a"
	"f : r \<mapsto>\<^bsub>\<AA>\<^esub> a"
	"umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	from is_functor_axioms r u prems'(1) have \<FF>g:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by (cs_concl cs_shallow cs_intro: cat_cs_intros)
	from bij[OF prems \<FF>g] have unique:
	"\<lbrakk>
	f' : r \<mapsto>\<^bsub>\<AA>\<^esub> a;
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u = umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
	\<rbrakk> \<Longrightarrow> g = f'"
	for f' by (metis prems'(1) u umap_of_ArrVal_app)
	from is_functor_axioms prems'(1,2) u have \<FF>g_u:
	"\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> u = umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
	by (cs_concl cs_simp: prems'(3)[symmetric] cat_cs_simps)
	show "g = f" by (rule unique[OF prems'(2) \<FF>g_u])
	qed (auto simp: cat_cs_simps cat_cs_intros)

	interpret umof_a: v11 \<open>umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<close> by (rule umof_a)

	show "\<R>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>) = Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	proof(intro vsubset_antisym)
	from u show "\<R>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
	by (rule umap_of_ArrVal_vrange)
	show "Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>)"
	proof(rule vsubsetI, unfold in_Hom_iff )
	fix f assume prems': "f : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	from bij[OF prems prems'] obtain f'
	where f': "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> a"
	and f_def: "f = umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	by auto
	from is_functor_axioms prems prems' u f' have
	"f' \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>)"
	by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
	from this show "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (umap_of \<FF> c r u a\<lparr>ArrVal\<rparr>)"
	unfolding f_def by (rule umof_a.vsv_vimageI2)
	qed

	qed

	qed simp_all

	from is_functor_axioms prems r u this show
	"ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub>
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	qed

	qed

	lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_of_is_iso_ntcf

	lemma (in is_functor) cf_ntcf_ua_fo_is_iso_ntcf:
	assumes "universal_arrow_fo \<FF> c r u"
	shows "ntcf_ua_fo \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(-,c) \<circ>\<^sub>C\<^sub>F op_cf \<FF> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	proof-
	from universal_arrow_foD[OF assms] have r: "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	by auto
	show ?thesis
	by
	(
	rule is_functor.cf_ntcf_ua_of_is_iso_ntcf
	[
	OF is_functor_op,
	unfolded cat_op_simps,
	OF assms,
	unfolded
	HomDom.cat_op_cat_cf_Hom_snd[OF r]
	HomCod.cat_op_cat_cf_Hom_snd[OF c]
	ntcf_ua_fo_def[symmetric]
	]
	)
	qed

	lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_fo_is_iso_ntcf

	lemma (in is_functor) cf_ua_of_if_ntcf_ua_of_is_iso_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	and "ntcf_ua_of \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "universal_arrow_of \<FF> c r u"
	proof(rule universal_arrow_ofI)
	interpret ua_of_u: is_iso_ntcf
	\<alpha>
	\<AA>
	\<open>cat_Set \<alpha>\<close>
	\<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<close>
	\<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>\<close>
	\<open>ntcf_ua_of \<alpha> \<FF> c r u\<close>
	by (rule assms(3))
	fix r' u' assume prems: "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	have "ntcf_ua_of \<alpha> \<FF> c r u\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub>
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	- by (rule is_iso_ntcf.iso_ntcf_is_arr_isomorphism[OF assms(3) prems(1)])
	+ by (rule is_iso_ntcf.iso_ntcf_is_iso_arr[OF assms(3) prems(1)])
	from this is_functor_axioms assms(1-2) prems have uof_r':
	"umap_of \<FF> c r u r' : Hom \<AA> r r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> Hom \<BB> c (\<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>)"
	by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
	- note uof_r' = cat_Set_is_arr_isomorphismD[OF uof_r']
	+ note uof_r' = cat_Set_is_iso_arrD[OF uof_r']
	interpret uof_r': v11 \<open>umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<close> by (rule uof_r'(2))
	from
	uof_r'.v11_vrange_ex1_eq[
	THEN iffD1, unfolded uof_r'(3,4) in_Hom_iff, OF prems(2)
	]
	show "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	by metis
	qed (intro assms)+

	lemma (in is_functor) cf_ua_fo_if_ntcf_ua_fo_is_iso_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "u : \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
	and "ntcf_ua_fo \<alpha> \<FF> c r u :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(-,c) \<circ>\<^sub>C\<^sub>F op_cf \<FF> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "universal_arrow_fo \<FF> c r u"
	proof-
	from assms(2) have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
	show ?thesis
	by
	(
	rule is_functor.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf
	[
	OF is_functor_op,
	unfolded cat_op_simps,
	OF assms(1,2),
	unfolded
	HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
	HomCod.cat_op_cat_cf_Hom_snd[OF c]
	ntcf_ua_fo_def[symmetric],
	OF assms(3)
	]
	)
	qed

	lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<phi> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "universal_arrow_of \<FF> c r (\<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>)"
	(is \<open>universal_arrow_of \<FF> c r ?u\<close>)
	proof-

	interpret \<phi>: is_iso_ntcf
	\<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<phi>
	by (rule assms(3))

	show ?thesis
	proof(intro universal_arrow_ofI assms)

	from assms(1,2) show u: "?u : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	fix r' u' assume prems: "r' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "u' : c \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
	have \<phi>r'_ArrVal_app[symmetric, cat_cs_simps]:
	"\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr> =
	\<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	if "f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'" for f'
	proof-
	have "\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
	(Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(c,-) \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>"
	using that by (intro \<phi>.ntcf_Comp_commute)
	then have
	"\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f']\<^sub>\<circ> =
	cf_hom \<BB> [\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>"
	using assms(1,2) that prems
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
	)
	then have
	"(\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f']\<^sub>\<circ>)\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> =
	(cf_hom \<BB> [\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
	\<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	by simp
	from this assms(1,2) u that show ?thesis
	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
	)
	qed

	show "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and> u' = umap_of \<FF> c r ?u r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	proof(intro ex1I conjI; (elim conjE)?)
	from assms prems show
	"(\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr>)\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>u'\<rparr> : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	by
	(
	cs_concl
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_arrow_cs_intros
	)
	with assms(1,2) prems show "u' =
	umap_of \<FF> c r ?u r'\<lparr>ArrVal\<rparr>\<lparr>(\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr>)\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>u'\<rparr>\<rparr>"
	by
	(
	cs_concl cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
	)
	fix f' assume prems':
	"f' : r \<mapsto>\<^bsub>\<AA>\<^esub> r'"
	"u' = umap_of \<FF> c r (\<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
	from prems'(2,1) assms(1,2) have u'_def:
	"u' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
	by
	(
	cs_prems cs_shallow
	cs_simp: cat_cs_simps cat_op_simps
	cs_intro: cat_cs_intros cat_op_intros
	)
	from prems' show "f' = (\<phi>\<lparr>NTMap\<rparr>\<lparr>r'\<rparr>)\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub>\<lparr>ArrVal\<rparr>\<lparr>u'\<rparr>"
	unfolding u'_def \<phi>r'_ArrVal_app[OF prems'(1)]
	by
	(
	cs_concl
	cs_simp: cat_cs_simps
	cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
	)

	qed

	qed

	qed

	lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf:
	assumes "r \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
	and "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
	and "\<phi> :
	Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(-,c) \<circ>\<^sub>C\<^sub>F op_cf \<FF> :
	op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
	shows "universal_arrow_fo \<FF> c r (\<phi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>)"
	by
	(
	rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf
	[
	OF is_functor_op,
	unfolded cat_op_simps,
	OF assms(1,2),
	unfolded
	HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
	HomCod.cat_op_cat_cf_Hom_snd[OF assms(2)]
	ntcf_ua_fo_def[symmetric],
	OF assms(3)
	]
	)

	text\<open>\newpage\<close>

	end
	\ No newline at end of file

File Metadata

Mime Type: application/octet-stream
Expires: Wed, May 22, 4:19 AM (1 d, 23 h)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: BuM1QEKDsHDC
Default Alt Text: (5 MB)

Offset	End	Complete
0	4194304	Yes
4194304	5280889	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions