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,676 +1,687 @@
 (* 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 [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
 
 
 
 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
 
 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
 
 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_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_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_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_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_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_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:
   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)
   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)
   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)
 
   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:
   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)] 
   by auto
 
 private lemma is_arr_isomorphism_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 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)
   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
       )
   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]:
   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>])
 
   interpret Rel: category \<alpha> \<open>cat_Rel \<alpha>\<close> by (rule 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)
 
   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]:
   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)
 
   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)
   
   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)
 
   from is_arr_isomorphismD[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)
 
   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] = \<Z>.cat_Rel_is_arr_isomorphismD(3,4)
 
 lemma (in \<Z>) cat_Rel_is_arr_isomorphism:
   "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:
   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] 
   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])
 
 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_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,2095 +1,2211 @@
 (* 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 [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
 
 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
 
 
 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"
   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
 
 
 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_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_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_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]
     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_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_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_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_simp: cat_cs_simps\<close>)+
     qed
   qed 
     (
       auto simp: 
         assms(2) cat_Set_components Vset_trans Vset_in_mono cat_cs_intros
     )
 qed
 
 
 
 subsection\<open>Isomorphism\<close>
 
 lemma cat_Set_is_arr_isomorphismI[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 
     "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 
     "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<alpha>\<^esub> B"
     by (cs_concl cs_simp: cat_sub_bw_cs_simps)
 qed
 
 lemma cat_Set_is_arr_isomorphismD[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: 
     "T : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Par \<alpha>\<^esub> B"
     by (cs_concl 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:
   "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
 
 
 
 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_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_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
   from wide_replete_subcategory_cat_Set_cat_Par assms have [cat_cs_simps]:
     "T\<inverse>\<^sub>C\<^bsub>cat_Set \<alpha>\<^esub> = T\<inverse>\<^sub>C\<^bsub>cat_Par \<alpha>\<^esub>"
     by 
       (
         cs_concl cs_full 
           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"
     by (cs_concl 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)]
   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_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 
     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 = 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_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_simp: cat_cs_simps)
 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 = 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_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_simp: cat_cs_simps)
 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_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_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:
   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 
       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_simp: cat_cs_simps cs_intro: V_cs_intros)
     then show "ab = ab'"  unfolding ab_def ab'_def by simp
   qed (cs_concl 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_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:
   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]:
   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:
   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 
       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_simp: cat_cs_simps cs_intro: V_cs_intros)
     then show "ab = ab'"  unfolding ab_def ab'_def by simp
   qed (cs_concl 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_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:
   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]:
   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'
 
 
 subsubsection\<open>Projection arrows are isomorphisms in the category \<open>Par\<close>\<close>
 
 lemma (in \<Z>) vfst_arrow_is_cat_Par_arr_isomorphism:
   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
           [
             THEN iffD1, 
             OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
               OF assms[unfolded cat_Par_components]
               ]
           ]
       )
 qed
 
 lemma (in \<Z>) vfst_arrow_is_cat_Par_arr_isomorphism'[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:
   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
           [
             THEN iffD1, 
             OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
               OF assms[unfolded cat_Par_components]
               ]
           ]
       )
 qed
 
 lemma (in \<Z>) vsnd_arrow_is_cat_Par_arr_isomorphism'[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'
 
 
 subsubsection\<open>Projection arrows are isomorphisms in the category \<open>Rel\<close>\<close>
 
 lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr_isomorphism:
   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
           [
             THEN iffD1, 
             OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
               OF assms[unfolded cat_Rel_components]
               ]
           ]
       )
 qed
 
 lemma (in \<Z>) vfst_arrow_is_cat_Rel_arr_isomorphism'[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:
   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
           [
             THEN iffD1, 
             OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
               OF assms[unfolded cat_Rel_components]
               ]
           ]
       )
 qed
 
 lemma (in \<Z>) vsnd_arrow_is_cat_Rel_arr_isomorphism'[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'
 
 
 
 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]|
 
 
 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>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"
   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]:
   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
 
 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
   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
   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_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_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
     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_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_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"
   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>"
 
 
 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>"
   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"
 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)"
       unfolding prod_2_Rel_def by simp
     show "vcard (prod_2_Rel S 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>"
       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>"
       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'"
   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>"
 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_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"
 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)"
       unfolding prod_2_Rel_def by simp
     show "vcard (prod_2_Rel S 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>"
       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>"
       by (cs_concl 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>"
       by (cs_concl 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"
       by (cs_concl cs_simp: cat_cs_simps)
     from assms show "prod_2_Rel S T\<lparr>ArrCod\<rparr> = B \<times>\<^sub>\<circ> D"
       by (cs_concl cs_simp: cat_cs_simps)
     show "vsv (prod_2_Rel S 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"
   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:
   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"
 proof-
   note S = cat_Set_is_arr_isomorphismD[OF assms(1)]
   note T = cat_Set_is_arr_isomorphismD[OF assms(2)]
   show ?thesis
   proof
     (
       intro cat_Set_is_arr_isomorphismI 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_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_simp: S(4) T(4) cs_intro: cat_cs_intros)
   qed (use S(2) T(2) in \<open>cs_concl cs_intro: prod_2_Rel_ArrVal_v11\<close>)
 qed
 
 lemma prod_2_Rel_is_cat_Set_arr_isomorphism'[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"
   using assms(1,2) 
   unfolding assms(3-5) 
   by (rule prod_2_Rel_is_cat_Set_arr_isomorphism)
 
 
 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)"
 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 :
       B \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'' \<times>\<^sub>\<circ> A''"
     by (cs_concl 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) : 
       B \<times>\<^sub>\<circ> A \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> B'' \<times>\<^sub>\<circ> A''"
     by (cs_concl 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)"
       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))"
       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>"
     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>"
       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_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>"
         by 
           (
             cs_concl 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>"
       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_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>"
         by
           (
             cs_concl 
               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>"
 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>) :
       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>))"
       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 \<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:
+  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>)"
+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)
+
+  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"
+    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>) :
+      B \<times>\<^sub>\<circ> D \<mapsto>\<^bsub>cat_Rel \<alpha>\<^esub> A \<times>\<^sub>\<circ> C" 
+    by (cs_concl 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_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>)"
+  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>)"
+      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
+    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>))"
+      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> 
+      by simp
+    from ST have arr_Rel_ST: "arr_Rel \<alpha> (prod_2_Rel S 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>"
+    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>"
+      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>"
+        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_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>"
+      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>"
+        unfolding bd_ac_def 
+        by
+          (
+            cs_concl
+              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>)),
       \<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>))"
     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_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_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: V_cs_intros)
   qed (cs_concl 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"
   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_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_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_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>
 
 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_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_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_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>" 
     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)
 
 lemma (in \<Z>) cat_Set_cf_comp_proj_obj_prod_up: 
   assumes "A \<in>\<^sub>\<circ> Vset \<alpha>" 
     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_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_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_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_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_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_simp: cat_cs_simps cat_Set_cs_simps \<phi>i(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
 
 lemma vequalizer_flip: "vequalizer a f g = vequalizer a g f"
   unfolding vequalizer_def by auto
 
 lemma (in \<Z>) 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)]
   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
 
   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_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_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_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_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
           (
             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_simp: cat_cs_simps\<close>)+
 
 qed
 
 
 
 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_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_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,1990 +1,2347 @@
 (* 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 catdag_cs_simps
-named_theorems catdag_cs_intros
+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 catdag_length: "vcard \<CC> = 2\<^sub>\<nat>"
-    and catdag_ObjMap_identity[catdag_cs_simps]: 
+  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 catdag_DagCat_idem[catdag_cs_simps]: 
+    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 [catdag_cs_simps] =
-  dagger_category.catdag_ObjMap_identity
-  dagger_category.catdag_DagCat_idem
+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'[cat_cs_intros]:
+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[catdag_cs_intros]:
+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) catdag_is_functor'[catdag_cs_intros]:
+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 [catdag_cs_intros] = dagger_category.catdag_is_functor'
+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 \<alpha> (dagcat_Rel \<alpha>)"
+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_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_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_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'[cat_cs_intros]:
+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_simp: mcat_cs_simps V_cs_simps)
     show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>" by (cs_concl 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_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_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_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_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_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_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_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)
+  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_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_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_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_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_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: 
     "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:
     "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_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_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_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
       )
   from 
     Set.is_arr_isomorphismI'
       [
         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:
     "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:
     "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
         \<close>
     )
 
 lemma (in \<Z>) 
   M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism'[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)
 
 lemmas [cat_rel_par_Set_cs_intros] = 
   \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism'
 
 lemma (in \<Z>) 
   M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism'[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)
 
 lemmas [cat_rel_par_Set_cs_intros] = 
   \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism'
 
 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: 
     "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: 
     "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
           [
             THEN iffD1, 
             OF M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_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
           [
             THEN iffD1, 
             OF M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_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]:
   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)
 
 lemmas [cat_rel_Par_set_cs_intros] = 
   \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Par_arr_isomorphism'
 
 lemma (in \<Z>) 
   M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism'[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)
 
 lemmas [cat_rel_Par_set_cs_intros] = 
   \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Par_arr_isomorphism'
 
 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: 
     "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: 
     "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
           [
             THEN iffD1, 
             OF M\<alpha>_Rel_arrow_lr_is_cat_Set_arr_isomorphism_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
           [
             THEN iffD1, 
             OF M\<alpha>_Rel_arrow_rl_is_cat_Set_arr_isomorphism_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]:
   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)
 
 lemmas [cat_Rel_par_set_cs_intros] =
   \<Z>.M\<alpha>_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'
 
 lemma (in \<Z>) 
   M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'[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)
 
 lemmas [cat_Rel_par_set_cs_intros] = 
   \<Z>.M\<alpha>_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'
 
 
 
 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_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_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))
     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"
       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 :
             (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)
         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 :
             (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)"
             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)"
             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
             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
             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_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_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
             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
             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_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_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_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>"
             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_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_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 
       "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 =
             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
           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_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>'"
+  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_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 
       "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 \<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
           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_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>'"
+  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>) 
+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_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_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_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_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_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>
           (
             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 \<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>
             (
               ?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>)
             ) = ?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_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_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_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_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_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_simp: cat_cs_simps\<close>)+
         qed
 
         from assms that show ?thesis
           unfolding mcat_Rel_components cat_Rel_components(1)
           by
             (
               cs_concl
                 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_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>
           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>)"
         (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_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_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_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_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_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_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_simp: dmcat_cs_simps V_cs_simps)
+    show "\<D>\<^sub>\<circ> \<AA> = \<D>\<^sub>\<circ> \<BB>" by (cs_concl 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_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_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_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_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/document/root.bib b/thys/CZH_Elementary_Categories/document/root.bib
--- a/thys/CZH_Elementary_Categories/document/root.bib
+++ b/thys/CZH_Elementary_Categories/document/root.bib
@@ -1,105 +1,116 @@
 @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{etingof_tensor_2015,
 	address = {Providence},
 	series = {Mathematical {Surveys} and {Monographs}},
 	title = {Tensor {Categories}},
 	isbn = {978-1-4704-2024-6},
 	number = {205},
 	publisher = {American Mathematical Society},
 	author = {Etingof, Pavel I. and Gelaki, Shlomo and Nikshych, Dmitri and Ostrik, Victor},
 	year = {2015},
 	keywords = {\$K\$-theory -- Higher algebraic \$K\$-theory -- Symmetric monoidal categories, Algebraic topology, Associative rings and algebras -- Hopf algebras, quantum groups and related topics -- Hopf algebras and their applications, Category theory; homological algebra -- Categories with structure -- Monoidal categories (= multiplicative categories), symmetric monoidal categories, braided categories, Group theory and generalizations -- Linear algebraic groups and related topics -- Quantum groups (quantized function algebras) and their representations, Hopf algebras, Nonassociative rings and algebras -- Lie algebras and Lie superalgebras -- Quantum groups (quantized enveloping algebras) and related deformations, Tensor fields},
 }
 @misc{noauthor_wikipedia_2001,
 	title = {Wikipedia},
 	url = {https://www.wikipedia.org/},
 	year = {2001},
 }
 @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{paulson_zermelo_2019,
 	title = {Zermelo {Fraenkel} {Set} {Theory} in {Higher}-{Order} {Logic}},
 	journal = {Archive of Formal Proofs},
 	author = {Paulson, Lawrence C.},
 	year = {2019},
 }
 @misc{noauthor_nlab_nodate,
 	title = {{nLab}},
 	url = {https://ncatlab.org/nlab/show/HomePage},
-	journal = {nLab},
 }
 @book{bodo_categories_1970,
 	address = {New York},
 	title = {Categories and {Functors}},
 	publisher = {Academic Press},
 	author = {Bodo, Pareigis},
 	year = {1970},
 }
 @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},
 }
 @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},
 }
 @article{paulson_natural_1986,
 	title = {Natural {Deduction} as {Higher}-{Order} {Resolution}},
 	volume = {3},
 	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{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},
 }
+@incollection{coecke_survey_2010,
+	address = {Heidelberg},
+	title = {A {Survey} of {Graphical} {Languages} for {Monoidal} {Categories}},
+	volume = {813},
+	isbn = {978-3-642-12820-2},
+	booktitle = {New {Structures} for {Physics}},
+	publisher = {Springer},
+	author = {Selinger, Peter},
+	editor = {Coecke, Bob},
+	year = {2010},
+	pages = {289--355},
+}
 @article{milehins_category_2021,
 	title = {Category {Theory} for {ZFC} in {HOL} {I}: {Foundations}: {Design} {Patterns}, {Set} {Theory}, {Digraphs}, {Semicategories}},
 	journal = {Archive of Formal Proofs},
 	author = {Milehins, Mihails},
 	year = {2021},
 }
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,875 +1,938 @@
 (* 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 
 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
 
 
 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>
 
 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_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_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_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]:
+  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]:
+  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]:
+  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_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_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_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_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_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_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,1063 +1,1074 @@
 (* 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 [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
 
 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}"
 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_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_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
     ]: 
   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_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_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
 
 
 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_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:
   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_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)
   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)
   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)
 
   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)
   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)
 
   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]:
   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)
   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)
  
   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)
       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)
       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:
   "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: 
   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 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>"
       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)
   
   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:
   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)
 
   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)
 
   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:
     "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_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
   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:
   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 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))
   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_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] 
         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]:
   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-
   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)
   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:
   "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>"
           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>" 
           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>"
           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>"
   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)
   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)
 
   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)
   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)
   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