diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Comma.thy
@@ -1,3371 +1,4763 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Comma categories\<close>
 theory CZH_ECAT_Comma
   imports 
     CZH_ECAT_NTCF
     CZH_ECAT_Simple
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems cat_comma_cs_simps
 named_theorems cat_comma_cs_intros
 
 
 
 subsection\<open>Comma category\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 See Exercise 1.3.vi in \cite{riehl_category_2016} or 
 Chapter II-6 in \cite{mac_lane_categories_2010}.
 \<close>
 
 definition cat_comma_Obj :: "V \<Rightarrow> V \<Rightarrow> V"
   where "cat_comma_Obj \<GG> \<HH> \<equiv> set
     {
       [a, b, f]\<^sub>\<circ> | a b f.
         a \<in>\<^sub>\<circ> \<GG>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
         b \<in>\<^sub>\<circ> \<HH>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr> \<and>
         f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
     }"
 
 lemma small_cat_comma_Obj[simp]: 
   "small
     {
       [a, b, f]\<^sub>\<circ> | a b f.
         a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<and> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<and> f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
     }"
   (is \<open>small ?abfs\<close>)
 proof-
   define Q where
     "Q i = (if i = 0 then \<AA>\<lparr>Obj\<rparr> else if i = 1\<^sub>\<nat> then \<BB>\<lparr>Obj\<rparr> else \<CC>\<lparr>Arr\<rparr>)" 
     for i
   have "?abfs \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
     unfolding Q_def
   proof
     (
       intro subsetI, 
       unfold mem_Collect_eq, 
       elim exE conjE, 
       intro vproductI; 
       simp only:
     )
     fix a b f show "\<D>\<^sub>\<circ> [a, b, f]\<^sub>\<circ> = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
       by (simp add: three nat_omega_simps)
   qed (force simp: nat_omega_simps)+
   then show "small ?abfs" by (rule down)
 qed
 
 definition cat_comma_Hom :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
-  where "cat_comma_Hom \<GG> \<HH> abf a'b'f' \<equiv> set
+  where "cat_comma_Hom \<GG> \<HH> A B \<equiv> set
     {
-      [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
-        abf \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-        a'b'f' \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-        g : abf\<lparr>0\<rparr> \<mapsto>\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> a'b'f'\<lparr>0\<rparr> \<and>
-        h : abf\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> a'b'f'\<lparr>1\<^sub>\<nat>\<rparr> \<and>
-        a'b'f'\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
-         \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> abf\<lparr>2\<^sub>\<nat>\<rparr>
+      [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
+        A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+        B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+        g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> B\<lparr>0\<rparr> \<and>
+        h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
+        B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
+         \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
     }"
 
 lemma small_cat_comma_Hom[simp]: "small
   {
-    [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
-      abf \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-      a'b'f' \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-      g : abf\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a'b'f'\<lparr>0\<rparr> \<and>
-      h : abf\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a'b'f'\<lparr>1\<^sub>\<nat>\<rparr> \<and>
-      a'b'f'\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> abf\<lparr>2\<^sub>\<nat>\<rparr>
+    [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
+      A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+      B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+      g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> B\<lparr>0\<rparr> \<and>
+      h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
+      B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
   }"
   (is \<open>small ?abf_a'b'f'_gh\<close>)
 proof-
   define Q where
     "Q i =
       (
         if i = 0
         then cat_comma_Obj \<GG> \<HH> 
         else if i = 1\<^sub>\<nat> then cat_comma_Obj \<GG> \<HH> else \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>
       )"
     for i
   have "?abf_a'b'f'_gh \<subseteq> elts (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
     unfolding Q_def
   proof
     (
       intro subsetI, 
       unfold mem_Collect_eq, 
       elim exE conjE,
       intro vproductI; 
       simp only:
     )
     fix a b f show "\<D>\<^sub>\<circ> [a, b, f]\<^sub>\<circ> = ZFC_in_HOL.set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
       by (simp add: three nat_omega_simps)
   qed (force simp : nat_omega_simps)+
   then show "small ?abf_a'b'f'_gh" by (rule down)
 qed
 
 definition cat_comma_Arr :: "V \<Rightarrow> V \<Rightarrow> V"
   where "cat_comma_Arr \<GG> \<HH> \<equiv>
     (
-      \<Union>\<^sub>\<circ>abf\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. \<Union>\<^sub>\<circ>a'b'f'\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
-        cat_comma_Hom \<GG> \<HH> abf a'b'f'
+      \<Union>\<^sub>\<circ>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. \<Union>\<^sub>\<circ>B\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
+        cat_comma_Hom \<GG> \<HH> A B
     )"
 
 definition cat_comma_composable :: "V \<Rightarrow> V \<Rightarrow> V"
   where "cat_comma_composable \<GG> \<HH> \<equiv> set
     {
-      [[a'b'f', a''b''f'', g'h']\<^sub>\<circ>, [abf, a'b'f', gh]\<^sub>\<circ>]\<^sub>\<circ> |
-        abf a'b'f' a''b''f'' g'h' gh.
-          [a'b'f', a''b''f'', g'h']\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and>
-          [abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
+      [[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ> | A B C G F.
+        [B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and> [A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
     }"
 
 lemma small_cat_comma_composable[simp]:
   shows "small
     {
-      [[a'b'f', a''b''f'', g'h']\<^sub>\<circ>, [abf, a'b'f', gh]\<^sub>\<circ>]\<^sub>\<circ> |
-        abf a'b'f' a''b''f'' g'h' gh.
-          [a'b'f', a''b''f'', g'h']\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and>
-          [abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
+      [[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ> | A B C G F.
+        [B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH> \<and> [A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>
     }"
   (is \<open>small ?S\<close>)
 proof(rule down)
   show "?S \<subseteq> elts (cat_comma_Arr \<GG> \<HH> \<times>\<^sub>\<bullet> cat_comma_Arr \<GG> \<HH>)" by auto
 qed
 
 definition cat_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
   where "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> =
     [
       cat_comma_Obj \<GG> \<HH>,
       cat_comma_Arr \<GG> \<HH>,
       (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>),
       (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>),
       (
         \<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
           [
             GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
             GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
             [
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
             ]\<^sub>\<circ>
           ]\<^sub>\<circ>
       ),
       (
-        \<lambda>abf\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
-          [abf, abf, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>abf\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>abf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
+        \<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
+          [A, A, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
       )
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cat_comma_components:
   shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> = cat_comma_Obj \<GG> \<HH>"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> = cat_comma_Arr \<GG> \<HH>"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr> =
       (
         \<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
           [
             GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
             GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
             [
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<GG>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<HH>\<lparr>HomDom\<rparr>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
             ]\<^sub>\<circ>
           ]\<^sub>\<circ>
       )"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr> =
       (
-        \<lambda>abf\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
-          [abf, abf, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>abf\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>abf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
+        \<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>.
+          [A, A, [\<GG>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<HH>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>
       )"
   unfolding cat_comma_def dg_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<AA> \<BB> \<CC> \<GG> \<HH>
   assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<HH>: "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule \<GG>)
 interpretation \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule \<HH>)
 
 lemma cat_comma_Obj_def':
   "cat_comma_Obj \<GG> \<HH> \<equiv> set
     {
       [a, b, f]\<^sub>\<circ> | a b f.
         a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<and> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<and> f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>
     }"
   unfolding cat_comma_Obj_def cat_cs_simps by simp
 
 lemma cat_comma_Hom_def':
-  "cat_comma_Hom \<GG> \<HH> abf a'b'f' \<equiv> set
+  "cat_comma_Hom \<GG> \<HH> A B \<equiv> set
     {
-      [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
-        abf \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-        a'b'f' \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
-        g : abf\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> a'b'f'\<lparr>0\<rparr> \<and>
-        h : abf\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a'b'f'\<lparr>1\<^sub>\<nat>\<rparr> \<and>
-        a'b'f'\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> abf\<lparr>2\<^sub>\<nat>\<rparr>
+      [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> | g h.
+        A \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+        B \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH> \<and>
+        g : A\<lparr>0\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> B\<lparr>0\<rparr> \<and>
+        h : A\<lparr>1\<^sub>\<nat>\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> B\<lparr>1\<^sub>\<nat>\<rparr> \<and>
+        B\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>
     }"
   unfolding cat_comma_Hom_def cat_cs_simps by simp
 
 lemma cat_comma_components':
   shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> = cat_comma_Obj \<GG> \<HH>"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> = cat_comma_Arr \<GG> \<HH>"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>0\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr> = (\<lambda>F\<in>\<^sub>\<circ>cat_comma_Arr \<GG> \<HH>. F\<lparr>1\<^sub>\<nat>\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr> =
       (
         \<lambda>GF\<in>\<^sub>\<circ>cat_comma_composable \<GG> \<HH>.
           [
             GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
             GF\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>,
             [
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>,
               GF\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> GF\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>
             ]\<^sub>\<circ>
           ]\<^sub>\<circ>
       )"
     and "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr> =
-      (\<lambda>abf\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. [abf, abf, [\<AA>\<lparr>CId\<rparr>\<lparr>abf\<lparr>0\<rparr>\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>abf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
+      (\<lambda>A\<in>\<^sub>\<circ>cat_comma_Obj \<GG> \<HH>. [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>A\<lparr>0\<rparr>\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
   unfolding cat_comma_components cat_cs_simps by simp_all
 
 end
 
 
 subsubsection\<open>Objects\<close>
 
 lemma cat_comma_ObjI[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "A = [a, b, f]\<^sub>\<circ>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   using assms(4-6) 
   unfolding cat_comma_Obj_def'[OF assms(1,2)] assms(3) cat_comma_components 
   by simp
 
 lemma cat_comma_ObjD[dest]:
   assumes "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   using assms
   unfolding 
     cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
   by auto
 
 lemma cat_comma_ObjE[elim]:
   assumes "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains a b f where "A = [a, b, f]\<^sub>\<circ>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   using assms
   unfolding 
     cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
   by auto
 
 
 subsubsection\<open>Arrows\<close>
 
 lemma cat_comma_HomI[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "abf = [a, b, f]\<^sub>\<circ>"
-    and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    and "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "A = [a, b, f]\<^sub>\<circ>"
+    and "B = [a', b', f']\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
-  shows "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
+  shows "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
   using assms(1,2,6-10)
   unfolding cat_comma_Hom_def'[OF assms(1,2)] assms(3-5)
   by 
     (
       intro in_set_CollectI exI conjI small_cat_comma_Hom, 
       unfold cat_comma_components'(1,2)[OF assms(1,2), symmetric],
       (
         cs_concl 
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )+
     )
     (clarsimp simp: nat_omega_simps)+
 
 lemma cat_comma_HomE[elim]:
-  assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
+  assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains a b f a' b' f' g h
-    where "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, b, f]\<^sub>\<circ>"
+      and "B = [a', b', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
   using assms(1) 
   by 
     (
       unfold
         cat_comma_components'[OF assms(2,3)] cat_comma_Hom_def'[OF assms(2,3)],
       elim in_small_setE; 
       (unfold mem_Collect_eq, elim exE conjE cat_comma_ObjE[OF _ assms(2,3)])?,
       insert that,
       all\<open>
         (unfold cat_comma_components'(1,2)[OF assms(2,3), symmetric],
         elim cat_comma_ObjE[OF _ assms(2,3)]) | -
         \<close>
     )
     (auto simp: nat_omega_simps)
 
 lemma cat_comma_HomD[dest]:
-  assumes "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
+  assumes "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
   using assms(1) by (force elim!: cat_comma_HomE[OF _ assms(2,3)])+
 
 lemma cat_comma_ArrI[cat_comma_cs_intros]: 
-  assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-    and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-    and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  assumes "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+    and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   shows "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
   using assms 
   unfolding cat_comma_components cat_comma_Arr_def 
   by (intro vifunionI)
 
 lemma cat_comma_ArrE[elim]:
   assumes "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  obtains abf a'b'f' 
-    where "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-      and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-      and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  obtains A B 
+    where "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+      and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   using assms unfolding cat_comma_components cat_comma_Arr_def by auto
 
 lemma cat_comma_ArrD[dest]: 
-  assumes "[abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  assumes "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-  shows "[abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-    and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-    and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  shows "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+    and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
 proof-
-  from assms obtain abf' a'b'f'' 
-    where "[abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf' a'b'f''"
-      and "abf' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-      and "a'b'f'' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  from assms obtain C D 
+    where "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> C D"
+      and "C \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and "D \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by (elim cat_comma_ArrE)
-  moreover from cat_comma_HomE[OF this(1) assms(2,3)] have 
-    "abf = abf'" and "a'b'f' = a'b'f''"
+  moreover from cat_comma_HomE[OF this(1) assms(2,3)] have "A = C" and "B = D"
     by auto
-  ultimately show "[abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-    and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-    and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  ultimately show "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+    and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by auto
 qed
 
 
 subsubsection\<open>Domain\<close>
 
 lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>)"
   unfolding cat_comma_components by simp
 
 lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
   unfolding cat_comma_components by simp
 
 lemma cat_comma_Dom_app[cat_comma_cs_simps]:
-  assumes "F = [abf, a'b'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>F\<rparr> = abf"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
   using assms(2) unfolding assms(1) cat_comma_components by simp
 
 lemma cat_comma_Dom_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset)
-  fix F assume "F \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>)"
-  then have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>" by (cs_prems cs_simp: cat_comma_cs_simps)
-  then obtain abf a'b'f' 
-    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-      and abf: "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-      and a'b'f': "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  fix ABF assume "ABF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>)"
+  then have "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>" by (cs_prems cs_simp: cat_comma_cs_simps)
+  then obtain A B 
+    where ABF: "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+      and A: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and B: "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by auto
   from this(1) obtain a b f a' b' f' g h
-    where "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, b, f]\<^sub>\<circ>"
+      and "B = [a', b', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by (elim cat_comma_HomE[OF _ assms(1,2)])
-  from F this abf a'b'f' show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  from ABF this A B show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
 qed (auto intro: cat_comma_cs_intros)
 
 
 subsubsection\<open>Codomain\<close>
 
 lemma cat_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>)"
   unfolding cat_comma_components by simp
 
 lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
   unfolding cat_comma_components by simp
 
 lemma cat_comma_Cod_app[cat_comma_cs_simps]:
-  assumes "F = [abf, a'b'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>F\<rparr> = a'b'f'"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
   using assms(2)
   unfolding assms(1) cat_comma_components
   by (simp add: nat_omega_simps)
 
 lemma cat_comma_Cod_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset)
-  fix F assume "F \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>)"
-  then have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>" by (cs_prems cs_simp: cat_comma_cs_simps)
-  then obtain abf a'b'f' 
-    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-      and abf: "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-      and a'b'f': "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  fix ABF assume "ABF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>)"
+  then have "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>" by (cs_prems cs_simp: cat_comma_cs_simps)
+  then obtain A B 
+    where F: "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+      and A: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and B: "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by auto
   from this(1) obtain a b f a' b' f' g h
-    where "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, b, f]\<^sub>\<circ>"
+      and "B = [a', b', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by (elim cat_comma_HomE[OF _ assms(1,2)])
-  from F this abf a'b'f' show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  from F this A B show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
 qed (auto intro: cat_comma_cs_intros)
 
 
 subsubsection\<open>Arrow with a domain and a codomain\<close>
 
 lemma cat_comma_is_arrI[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "F = [abf, a'b'f', gh]\<^sub>\<circ>"
-    and "abf = [a, b, f]\<^sub>\<circ>"
-    and "a'b'f' = [a', b', f']\<^sub>\<circ>"
-    and "gh = [g, h]\<^sub>\<circ>"
+    and "ABF = [A, B, F]\<^sub>\<circ>"
+    and "A = [a, b, f]\<^sub>\<circ>"
+    and "B = [a', b', f']\<^sub>\<circ>"
+    and "F = [g, h]\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
-  shows "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
+  shows "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
 proof(intro is_arrI)
   interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
-  from assms(7-11) show "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  from assms(7-11) show "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
     unfolding assms(3-6)
     by 
       (
         cs_concl 
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
-  with assms(7-11) show 
-    "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>F\<rparr> = abf" "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>F\<rparr> = a'b'f'"
+  with assms(7-11) show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
     unfolding assms(3-6) by (cs_concl cs_simp: cat_comma_cs_simps)+
 qed
 
 lemma cat_comma_is_arrD[dest]:
   assumes "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> :
     [a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> [a', b', f']\<^sub>\<circ>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   note F_is_arrD = is_arrD[OF assms(1)]
   note F_cat_comma_ArrD = cat_comma_ArrD[OF F_is_arrD(1) assms(2,3)]
   show "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+    
 qed
 
 lemma cat_comma_is_arrE[elim]:
-  assumes "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
+  assumes "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains a b f a' b' f' g h
-    where "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, b, f]\<^sub>\<circ>"
+      and "B = [a', b', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   note F_is_arrD = is_arrD[OF assms(1)]
-  from F_is_arrD(1) obtain abf a'b'f' 
-    where "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-      and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
-      and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  from F_is_arrD(1) obtain C D 
+    where "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> C D"
+      and "C \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
+      and "D \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
     by auto
   from this(1) obtain a b f a' b' f' g h
-    where F_def: "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where F_def: "ABF = [C, D, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "C = [a, b, f]\<^sub>\<circ>"
+      and "D = [a', b', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
      by (elim cat_comma_HomE[OF _ assms(2,3)])
   with that show ?thesis 
     by (metis F_is_arrD(1,2,3) cat_comma_Cod_app cat_comma_Dom_app)
 qed
 
 
 subsubsection\<open>Composition\<close>
 
 lemma cat_comma_composableI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "GF = [G, F]\<^sub>\<circ>"
-    and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
-    and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
-  shows "GF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
+    and "ABCGF = [BCG, ABF]\<^sub>\<circ>"
+    and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
+    and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+  shows "ABCGF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
 proof-
   from assms(1,2,5) obtain a b f a' b' f' gh 
-    where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, gh]\<^sub>\<circ>"
-      and "abf = [a, b, f]\<^sub>\<circ>"
-      and  "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, gh]\<^sub>\<circ>"
+      and "A = [a, b, f]\<^sub>\<circ>"
+      and  "B = [a', b', f']\<^sub>\<circ>"
     by auto
   with assms(1,2,4) obtain a'' b'' f'' g'h' 
-    where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, g'h']\<^sub>\<circ>"
-      and "a'b'f' = [a', b', f']\<^sub>\<circ>"
-      and "a''b''f'' = [a'', b'', f'']\<^sub>\<circ>"
+    where BCG_def: "BCG = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, g'h']\<^sub>\<circ>"
+      and "B = [a', b', f']\<^sub>\<circ>"
+      and "C = [a'', b'', f'']\<^sub>\<circ>"
     by auto
-  from is_arrD(1)[OF assms(4)] have "G \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
+  from is_arrD(1)[OF assms(4)] have "BCG \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
     unfolding cat_comma_components'(2)[OF assms(1,2)].
-  moreover from is_arrD(1)[OF assms(5)] have "F \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
+  moreover from is_arrD(1)[OF assms(5)] have "ABF \<in>\<^sub>\<circ> cat_comma_Arr \<GG> \<HH>"
     unfolding cat_comma_components'(2)[OF assms(1,2)].
   ultimately show ?thesis 
-    unfolding assms(3) F_def G_def cat_comma_composable_def 
+    unfolding assms(3) ABF_def BCG_def cat_comma_composable_def 
     by simp
 qed
 
 lemma cat_comma_composableE[elim]:
-  assumes "GF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
+  assumes "ABCGF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-  obtains G F abf a'b'f' a''b''f'' 
-    where "GF = [G, F]\<^sub>\<circ>"
-      and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
-      and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
+  obtains BCG ABF A B C
+    where "ABCGF = [BCG, ABF]\<^sub>\<circ>"
+      and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
+      and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
 proof-
-  from assms(1) obtain abf a'b'f' a''b''f'' g'h' gh 
-    where GF_def: "GF = [[a'b'f', a''b''f'', g'h']\<^sub>\<circ>, [abf, a'b'f', gh]\<^sub>\<circ>]\<^sub>\<circ>"
-      and g'h': "[a'b'f', a''b''f'', g'h']\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-      and gh: "[abf, a'b'f', gh]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  from assms(1) obtain A B C G F 
+    where ABCGF_def: "ABCGF = [[B, C, G]\<^sub>\<circ>, [A, B, F]\<^sub>\<circ>]\<^sub>\<circ>"
+      and BCG: "[B, C, G]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      and ABF: "[A, B, F]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
     unfolding cat_comma_composable_def
     by (auto simp: cat_comma_components'[OF assms(2,3)])  
-  note g'h' = cat_comma_ArrD[OF g'h' assms(2,3)]
-    and gh = cat_comma_ArrD[OF gh assms(2,3)]
-  from gh(1) assms(2,3) obtain a b f a' b' f' g h
-    where "[abf, a'b'f', gh]\<^sub>\<circ> = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
-      and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
-      and gh_def: "gh = [g, h]\<^sub>\<circ>"
+  note BCG = cat_comma_ArrD[OF BCG assms(2,3)]
+    and ABF = cat_comma_ArrD[OF ABF assms(2,3)]
+  from ABF(1) assms(2,3) obtain a b f a' b' f' g h
+    where "[A, B, F]\<^sub>\<circ> = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [a, b, f]\<^sub>\<circ>"
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
+      and F_def: "F = [g, h]\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and [cat_comma_cs_simps]: 
         "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by auto
-  with g'h'(1) assms(2,3) obtain a'' b'' f'' g' h'
-    where g'h'_def: "[a'b'f', a''b''f'', g'h']\<^sub>\<circ> = [a'b'f', a''b''f'', [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
-      and a''b''f''_def: "a''b''f'' = [a'', b'', f'']\<^sub>\<circ>"
-      and g'h'_def: "g'h' = [g', h']\<^sub>\<circ>"
+  with BCG(1) assms(2,3) obtain a'' b'' f'' g' h'
+    where g'h'_def: "[B, C, G]\<^sub>\<circ> = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+      and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
+      and G_def: "G = [g', h']\<^sub>\<circ>"
       and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
       and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
       and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
       and [cat_comma_cs_simps]: 
         "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
     by auto  
-  from gh_def have "gh = [g, h]\<^sub>\<circ>" by simp
-  from assms(2,3) GF_def g h f f' g' h' f'' have 
-    "[a'b'f', a''b''f'', g'h']\<^sub>\<circ> : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
-    unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
+  from F_def have "F = [g, h]\<^sub>\<circ>" by simp
+  from assms(2,3) g h f f' g' h' f'' have 
+    "[B, C, G]\<^sub>\<circ> : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
+    unfolding ABCGF_def F_def G_def A_def B_def C_def
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
-  moreover from assms(2,3) GF_def g h f f' g' h' f'' have 
-    "[abf, a'b'f', gh]\<^sub>\<circ> : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
-    unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
+  moreover from assms(2,3) g h f f' g' h' f'' have 
+    "[A, B, F]\<^sub>\<circ> : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+    unfolding ABCGF_def F_def G_def A_def B_def C_def
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
-  ultimately show ?thesis using that GF_def by auto
+  thm that
+  ultimately show ?thesis using that ABCGF_def by auto
 qed
 
 lemma cat_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>)"
   unfolding cat_comma_components by auto
 
 lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]: 
   "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>) = cat_comma_composable \<GG> \<HH>"
   unfolding cat_comma_components by auto
 
 lemma cat_comma_Comp_app[cat_comma_cs_simps]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "G = [a'b'f', a''b''f'', [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
-    and "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''" 
-    and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F = [abf, a''b''f'', [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, h' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> h]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "G = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+    and "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" 
+    and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+  shows "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F = [A, C, [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, h' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> h]\<^sub>\<circ>]\<^sub>\<circ>"
   using assms(1,2,5,6)
   unfolding cat_comma_components'[OF assms(1,2)] assms(3,4)
   by (*slow*)
     (
       cs_concl
         cs_simp: omega_of_set V_cs_simps vfsequence_simps
         cs_intro: nat_omega_intros V_cs_intros cat_comma_composableI TrueI
     )
 
 lemma cat_comma_Comp_is_arr[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''" 
-    and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
+    and "BCG : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" 
+    and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+  shows "BCG \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
 proof-
   interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
   from assms(1,2,4) obtain a b f a' b' f' g h
-    where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
-      and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [a, b, f]\<^sub>\<circ>"
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
       and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and [symmetric, cat_cs_simps]: 
         "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by auto
   with assms(1,2,3) obtain a'' b'' f'' g' h'
-    where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
-      and a''b''f''_def: "a''b''f'' = [a'', b'', f'']\<^sub>\<circ>"
+    where BCG_def: "BCG = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+      and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
       and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
       and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
-      and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
       and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
     by auto (*slow*)
   from g' have \<GG>g': "\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   note [cat_cs_simps] = 
     category.cat_assoc_helper[
       where \<CC>=\<CC> and h=f'' and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
       ]
     category.cat_assoc_helper[
       where \<CC>=\<CC> and h=f and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close> and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
       ]
   from assms(1,2,3,4) g h f f' g' h' f'' show ?thesis
-    unfolding F_def G_def abf_def a'b'f'_def a''b''f''_def
+    unfolding ABF_def BCG_def A_def B_def C_def
     by (intro cat_comma_is_arrI[OF assms(1,2)])
       (
-        cs_concl 
+        cs_concl
           cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
       )+
 qed
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_comma_CId_vsv[cat_comma_cs_intros]: "vsv (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>)"
   unfolding cat_comma_components by simp
 
 lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   unfolding cat_comma_components'[OF assms(1,2)] by simp
 
 lemma cat_comma_CId_app[cat_comma_cs_simps]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "A = [a, b ,f]\<^sub>\<circ>"
     and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   shows "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(4)[unfolded assms(3), unfolded cat_comma_components'[OF assms(1,2)]]
   have "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> cat_comma_Obj \<GG> \<HH>".
   then show ?thesis
     unfolding cat_comma_components'(6)[OF assms(1,2)] assms(3)
     by (simp add: nat_omega_simps)
 qed
 
 
 subsubsection\<open>\<open>Hom\<close>-set\<close>
 
 lemma cat_comma_Hom:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
-    and "abf \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-    and "a'b'f' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
-  shows "Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) abf a'b'f' = cat_comma_Hom \<GG> \<HH> abf a'b'f'"
+    and "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    and "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+  shows "Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) A B = cat_comma_Hom \<GG> \<HH> A B"
 proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
-  fix F assume "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
-  with assms(1,2) show "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
+  fix ABF assume "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+  with assms(1,2) show "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
     by (elim cat_comma_is_arrE[OF _ assms(1,2)], intro cat_comma_HomI) force+
 next
-  fix F assume "F \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> abf a'b'f'"
-  with assms(1,2) show "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
+  fix ABF assume "ABF \<in>\<^sub>\<circ> cat_comma_Hom \<GG> \<HH> A B"
+  with assms(1,2) show "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
     by (elim cat_comma_HomE[OF _ assms(1,2)], intro cat_comma_is_arrI) force+
 qed
 
 
 subsubsection\<open>Comma category is a category\<close>
 
 lemma category_cat_comma[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "category \<alpha> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
 proof-
 
   interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
 
   show ?thesis
   proof(rule categoryI')
 
     show "vfsequence (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)" unfolding cat_comma_def by auto
     show "vcard (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) = 6\<^sub>\<nat>"
       unfolding cat_comma_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
       by (rule cat_comma_Dom_vrange[OF assms])
     show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
       by (rule cat_comma_Cod_vrange[OF assms])
     show "(GF \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Comp\<rparr>)) \<longleftrightarrow>
       (\<exists>g f b c a. GF = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b)"
       for GF
     proof(intro iffI; (elim exE conjE)?; (simp only: cat_comma_Comp_vdomain)?)
       assume prems: "GF \<in>\<^sub>\<circ> cat_comma_composable \<GG> \<HH>"
       with assms obtain G F abf a'b'f' a''b''f'' 
         where "GF = [G, F]\<^sub>\<circ>"
           and "G : a'b'f' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a''b''f''"
           and "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
         by auto
       with assms show "\<exists>g f b c a.
         GF = [g, f]\<^sub>\<circ> \<and> g : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c \<and> f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b"
         by auto
     qed (use assms in \<open>cs_concl cs_intro: cat_comma_composableI\<close>)
     from assms show "\<D>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_comma_cs_simps)
-    from assms show "g \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c"
-      if "g : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b"
-      for b c g a f
+    from assms show "G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
+      if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+      for B C G A F
       using that by (cs_concl cs_intro: cat_comma_cs_intros)
     from assms show 
       "H \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F =
         H \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> (G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F)"
       if "H : C \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> D"
         and "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C"
         and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
       for C D H B G A F
       using assms that
     proof-
       from that(3) assms obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [a, b, f]\<^sub>\<circ>"
           and B_def: "B = [a', b', f']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
           and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
         by auto
       with that(2) assms obtain a'' b'' f'' g' h'
         where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
           and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
           and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
           and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
           and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
           and [cat_cs_simps]: 
             "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
         by auto (*slow*)
       with that(1) assms obtain a''' b''' f''' g'' h''
         where H_def: "H = [[a'', b'', f'']\<^sub>\<circ>, [a''', b''', f''']\<^sub>\<circ>, [g'', h'']\<^sub>\<circ>]\<^sub>\<circ>"
           and D_def: "D = [a''', b''', f''']\<^sub>\<circ>"
           and g'': "g'' : a'' \<mapsto>\<^bsub>\<AA>\<^esub> a'''"
           and h'': "h'' : b'' \<mapsto>\<^bsub>\<BB>\<^esub> b'''"
           and f''': "f''' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'''\<rparr>"
           and [cat_cs_simps]: 
             "f''' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g''\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h''\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
         by auto (*slow*)      
-      note [cat_cs_simps] = 
+      note [cat_cs_simps] =
         category.cat_assoc_helper[
-          where \<CC>=\<CC> 
-            and h=f'' 
-            and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> 
+          where \<CC>=\<CC>
+            and h=f''
+            and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
             and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
           ]
         category.cat_assoc_helper[
-          where \<CC>=\<CC> 
-            and h=f'' 
-            and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> 
+          where \<CC>=\<CC>
+            and h=f''
+            and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close>
             and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
           ]
         category.cat_assoc_helper[
           where \<CC>=\<CC> 
             and h=f''' 
             and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g''\<rparr>\<close> 
             and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h''\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''\<close>
           ]
       from assms that g h f f' g' h' f'' g'' h''  f''' show ?thesis
         unfolding F_def G_def H_def A_def B_def C_def D_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps 
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
     qed
 
-    show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a"
-      if "a \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for a
+    show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr> : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> A"
+      if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
       using that
       by (elim cat_comma_ObjE[OF _ assms(1)]; (simp only:)?) 
         (
           cs_concl
             cs_simp: cat_cs_simps cat_comma_cs_simps 
             cs_intro: cat_cs_intros cat_comma_cs_intros
         )+
 
-    show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> f = f"
-      if "f : a \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> b" for a b f
+    show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F = F"
+      if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
       using that 
       by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_comma_cs_simps 
             cs_intro: cat_cs_intros cat_comma_cs_intros
         )+
 
-    show "f \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
-      if "f : b \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> c" for b c f
+    show "F \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>B\<rparr> = F"
+      if "F : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" for B C F
       using that 
       by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
         (
           cs_concl
             cs_simp: cat_cs_simps cat_comma_cs_simps 
             cs_intro: cat_cs_intros cat_comma_cs_intros
         )+
 
     show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
     proof(intro vsubsetI, elim cat_comma_ObjE[OF _ assms])
       fix F a b f assume prems: 
         "F = [a, b, f]\<^sub>\<circ>" 
         "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       from prems(2-4) show "F \<in>\<^sub>\<circ> Vset \<alpha>"
         unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros) 
     qed
 
     show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
       if "A \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
         and "B \<subseteq>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
         and "A \<in>\<^sub>\<circ> Vset \<alpha>"
         and "B \<in>\<^sub>\<circ> Vset \<alpha>"
       for A B
     proof-
 
       define A0 where "A0 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>0\<rparr>)"
       define A1 where "A1 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>1\<^sub>\<nat>\<rparr>)"
       define B0 where "B0 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>0\<rparr>)"
       define B1 where "B1 = \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>1\<^sub>\<nat>\<rparr>)"
 
       define A0B0 where "A0B0 = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A0. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B0. Hom \<AA> a b)"
       define A1B1 where "A1B1 = (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A1. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B1. Hom \<BB> a b)"
 
       have A0B0: "A0B0 \<in>\<^sub>\<circ> Vset \<alpha>"
         unfolding A0B0_def
       proof(rule \<GG>.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
         show "A0 \<in>\<^sub>\<circ> Vset \<alpha>"
           unfolding A0_def
         proof(intro vrange_vprojection_in_VsetI that(3))
           fix F assume "F \<in>\<^sub>\<circ> A"
           with that(1) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
           with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
           show "vsv F" unfolding F_def by auto
           show "0 \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by simp
         qed auto
         show "B0 \<in>\<^sub>\<circ> Vset \<alpha>"
           unfolding B0_def
         proof(intro vrange_vprojection_in_VsetI that(4))
           fix F assume "F \<in>\<^sub>\<circ> B"
           with that(2) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
           with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
           show "vsv F" unfolding F_def by auto
           show "0 \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by simp
         qed auto
       next
         fix a assume "a \<in>\<^sub>\<circ> A0"
         with that(1) obtain F 
           where a_def: "a = F\<lparr>0\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
           unfolding A0_def by force
         with assms obtain b f where "F = [a, b, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
         then show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding a_def by simp
       next
         fix a assume "a \<in>\<^sub>\<circ> B0"
         with that(2) obtain F 
           where a_def: "a = F\<lparr>0\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
           unfolding B0_def by force
         with assms obtain b f where "F = [a, b, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
         then show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding a_def by simp
       qed
 
       have A1B1: "A1B1 \<in>\<^sub>\<circ> Vset \<alpha>"
         unfolding A1B1_def
       proof(rule \<FF>.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
         show "A1 \<in>\<^sub>\<circ> Vset \<alpha>"
           unfolding A1_def
         proof(intro vrange_vprojection_in_VsetI that(3))
           fix F assume "F \<in>\<^sub>\<circ> A"
           with that(1) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
           with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
           show "vsv F" unfolding F_def by auto
           show "1\<^sub>\<nat> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by (simp add: nat_omega_simps)
         qed auto
         show "B1 \<in>\<^sub>\<circ> Vset \<alpha>"
           unfolding B1_def
         proof(intro vrange_vprojection_in_VsetI that(4))
           fix F assume "F \<in>\<^sub>\<circ> B"
           with that(2) have "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" by auto
           with assms obtain a b f where F_def: "F = [a, b, f]\<^sub>\<circ>" by auto
           show "vsv F" unfolding F_def by auto
           show "1\<^sub>\<nat> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> F" unfolding F_def by (simp add: nat_omega_simps)
         qed auto
       next
         fix b assume "b \<in>\<^sub>\<circ> A1"
         with that(1) obtain F 
           where b_def: "b = F\<lparr>1\<^sub>\<nat>\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
           unfolding A1_def by force
         with assms obtain a f where "F = [a, b, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           by (auto simp: nat_omega_simps)
         then show "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding b_def by simp
       next
         fix b assume "b \<in>\<^sub>\<circ> B1"
         with that(2) obtain F 
           where b_def: "b = F\<lparr>1\<^sub>\<nat>\<rparr>" and "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" 
           unfolding B1_def by force
         with assms obtain a f where "F = [a, b, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           by (auto simp: nat_omega_simps)
         then show "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding b_def by simp
       qed
       
       define Q where 
         "Q i = (if i = 0 then A else if i = 1\<^sub>\<nat> then B else (A0B0 \<times>\<^sub>\<bullet> A1B1))" 
         for i
       have 
         "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B.
           Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
       proof
         (
           intro vsubsetI,
           elim vifunionE,
           unfold in_Hom_iff,
           intro vproductI ballI
         )
         fix abf a'b'f' F assume prems: 
           "abf \<in>\<^sub>\<circ> A" "a'b'f' \<in>\<^sub>\<circ> B" "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
         from prems(3) assms obtain a b f a' b' f' g h
           where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
             and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
             and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
             and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
             and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
             and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
             and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
             and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
           by auto
         have gh: "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> A0B0 \<times>\<^sub>\<bullet> A1B1"
           unfolding A0B0_def A1B1_def 
         proof
           (
             intro ftimesI2 vifunionI, 
             unfold in_Hom_iff A0_def B0_def A1_def B1_def
           )
           from prems(1) show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>0\<rparr>)"
             by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
           from prems(2) show "a' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>0\<rparr>)"
             by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
               (simp_all add: a'b'f'_def)
           from prems(1) show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>A. F\<lparr>1\<^sub>\<nat>\<rparr>)"
             by (intro vsv.vsv_vimageI2'[where a=abf]) 
               (simp_all add: nat_omega_simps abf_def)
           from prems(2) show "b' \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>F\<in>\<^sub>\<circ>B. F\<lparr>1\<^sub>\<nat>\<rparr>)"
             by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
               (simp_all add: nat_omega_simps a'b'f'_def)
         qed (intro g h)+
         show "vsv F" unfolding F_def by auto
         show "\<D>\<^sub>\<circ> F = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
           by (simp add: F_def three nat_omega_simps)
         fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
         then consider \<open>i = 0\<close> | \<open>i = 1\<^sub>\<nat>\<close> | \<open>i = 2\<^sub>\<nat>\<close> by auto
         from this prems show "F\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i" 
           by cases
             (simp_all add: F_def Q_def gh abf_def a'b'f'_def nat_omega_simps)
       qed
       moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
       proof(rule Limit_vproduct_in_VsetI)
         show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>" by (cs_concl cs_intro: V_cs_intros)
         from A0B0 A1B1 assms(1,2) that(3,4) show 
           "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" 
           for i 
           by (simp_all add: Q_def Limit_ftimes_in_VsetI nat_omega_simps)
       qed auto
       ultimately show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) a b) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
     qed
   qed (auto simp: cat_comma_cs_simps intro: cat_comma_cs_intros)
 
 qed
 
 
 subsubsection\<open>Tiny comma category\<close>
 
 lemma tiny_category_cat_comma[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "tiny_category \<alpha> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
 proof-
 
   interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
   note \<GG> = \<GG>.is_functor_axioms 
     and \<HH> = \<HH>.is_functor_axioms
   interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
 
   show ?thesis
   proof(intro tiny_categoryI' category_cat_comma)
     have vrange_\<GG>: "\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
       by (simp add: vrange_in_VsetI \<GG>.tm_cf_ObjMap_in_Vset)
     moreover have vrange_\<HH>: "\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
       by (simp add: vrange_in_VsetI \<HH>.tm_cf_ObjMap_in_Vset)
     ultimately have UU_Hom_in_Vset:
       "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b) \<in>\<^sub>\<circ> Vset \<alpha>"
       using \<GG>.cf_ObjMap_vrange \<HH>.cf_ObjMap_vrange 
       by (auto intro: \<GG>.HomCod.cat_Hom_vifunion_in_Vset) 
     define Q where
       "Q i =
         (
           if i = 0
           then \<AA>\<lparr>Obj\<rparr>
           else
             if i = 1\<^sub>\<nat>
             then \<BB>\<lparr>Obj\<rparr>
             else (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b)
         )" 
       for i
     have "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
     proof(intro vsubsetI)
       fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
       then obtain a b f
         where A_def: "A = [a, b, f]\<^sub>\<circ>"
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by (elim cat_comma_ObjE[OF _ \<GG> \<HH>])
       from f have f:
         "f \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<GG>\<lparr>ObjMap\<rparr>). \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> (\<HH>\<lparr>ObjMap\<rparr>). Hom \<CC> a b)"
         by (intro vifunionI, unfold in_Hom_iff)
           (
             simp_all add: 
               a b 
               \<HH>.ObjMap.vsv_vimageI2 
               \<HH>.cf_ObjMap_vdomain 
               \<GG>.ObjMap.vsv_vimageI2 
               \<GG>.cf_ObjMap_vdomain
           )
       show "A \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
       proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
         show "\<D>\<^sub>\<circ> A = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
           unfolding A_def by (simp add: three nat_omega_simps)
         fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
         then consider \<open>i = 0\<close> | \<open>i = 1\<^sub>\<nat>\<close> | \<open>i = 2\<^sub>\<nat>\<close> by auto
         from this a b f show "A\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
           unfolding A_def Q_def by cases (simp_all add: nat_omega_simps)
       qed (auto simp: A_def)
     qed
     moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule Limit_vproduct_in_VsetI)
       show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
         unfolding three[symmetric] by simp
       from this show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
         using that assms(1,2) UU_Hom_in_Vset  
         by 
           (
             simp_all add:
               Q_def 
               \<GG>.HomDom.tiny_cat_Obj_in_Vset 
               \<HH>.HomDom.tiny_cat_Obj_in_Vset 
               nat_omega_simps
           )
     qed auto
     ultimately show [simp]: "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto 
     define Q where
       "Q i =
         (
           if i = 0
           then \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>
           else
             if i = 1\<^sub>\<nat>
             then \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>
             else \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>
         )" 
     for i
     have "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
     proof(intro vsubsetI)
       fix F assume "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
       then obtain abf a'b'f' where F: "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'"
         by (auto intro: is_arrI)
       with assms obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and abf_def: "abf = [a, b, f]\<^sub>\<circ>"
           and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
           and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
         by auto
       from g h have "[g, h]\<^sub>\<circ> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr>" by auto      
       show "F \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i)"
       proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
         show "\<D>\<^sub>\<circ> F = set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
           by (simp add: F_def three nat_omega_simps)
         fix i assume "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}"
         then consider \<open>i = 0\<close> | \<open>i = 1\<^sub>\<nat>\<close> | \<open>i = 2\<^sub>\<nat>\<close> by auto
         from this F g h show "F\<lparr>i\<rparr> \<in>\<^sub>\<circ> Q i"
           unfolding Q_def F_def abf_def[symmetric] a'b'f'_def[symmetric]
           by cases (auto simp: nat_omega_simps)
       qed (auto simp: F_def)
     qed
     moreover have "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}. Q i) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule Limit_vproduct_in_VsetI)
       show "set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>} \<in>\<^sub>\<circ> Vset \<alpha>"
         by (simp add: three[symmetric] nat_omega_simps)
       moreover have "\<AA>\<lparr>Arr\<rparr> \<times>\<^sub>\<bullet> \<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
         by 
           (
             auto intro!: 
               Limit_ftimes_in_VsetI 
               \<GG>.\<Z>_\<beta> \<Z>_def 
               \<GG>.HomDom.tiny_cat_Arr_in_Vset 
               \<HH>.HomDom.tiny_cat_Arr_in_Vset
           )
       ultimately show "Q i \<in>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> set {0, 1\<^sub>\<nat>, 2\<^sub>\<nat>}" for i
         using that assms(1,2) UU_Hom_in_Vset  
         by 
           (
             simp_all add:
               Q_def
               \<GG>.HomDom.tiny_cat_Obj_in_Vset 
               \<HH>.HomDom.tiny_cat_Obj_in_Vset 
               nat_omega_simps
           )
     qed auto
     ultimately show "\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
   qed (rule \<GG>, rule \<HH>)
 
 qed
 
 
 
+subsection\<open>Opposite comma category functor\<close>
+
+
+subsubsection\<open>Background\<close>
+
+
+text\<open>
+See \cite{noauthor_wikipedia_2001}\footnote{
+\url{https://en.wikipedia.org/wiki/Opposite_category}
+} for background information.
+\<close>
+
+
+subsubsection\<open>Object flip\<close>
+
+definition op_cf_commma_obj_flip :: "V \<Rightarrow> V \<Rightarrow> V"
+  where "op_cf_commma_obj_flip \<GG> \<HH> =
+    (\<lambda>A\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>. [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>0\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
+
+
+text\<open>Elementary properties.\<close>
+
+mk_VLambda op_cf_commma_obj_flip_def
+  |vsv op_cf_commma_obj_flip_vsv[cat_comma_cs_intros]|
+  |vdomain op_cf_commma_obj_flip_vdomain[cat_comma_cs_simps]|
+  |app op_cf_commma_obj_flip_app'|
+
+lemma op_cf_commma_obj_flip_app[cat_comma_cs_simps]:
+  assumes "A = [a, b, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
+  shows "op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> = [b, a, f]\<^sub>\<circ>"
+  using assms unfolding op_cf_commma_obj_flip_def by (simp add: nat_omega_simps)
+
+lemma op_cf_commma_obj_flip_v11[cat_comma_cs_intros]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "v11 (op_cf_commma_obj_flip \<GG> \<HH>)"
+proof(rule vsv.vsv_valeq_v11I, unfold op_cf_commma_obj_flip_vdomain)
+  fix A B assume prems:
+    "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    "B \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    "op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr>"
+  from prems(1,2) assms obtain a b f a' b' f' 
+    where A_def: "A = [a, b, f]\<^sub>\<circ>" 
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
+    by (elim cat_comma_ObjE[OF _ assms])
+  from prems(3,1,2) show "A = B"
+    by (simp_all add: A_def B_def op_cf_commma_obj_flip_app nat_omega_simps)
+qed (auto intro: op_cf_commma_obj_flip_vsv)
+
+lemma op_cf_commma_obj_flip_vrange[cat_comma_cs_simps]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "\<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
+proof(intro vsubset_antisym)
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  show "\<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>) \<subseteq>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
+  proof
+    (
+      intro vsv.vsv_vrange_vsubset op_cf_commma_obj_flip_vsv, 
+      unfold cat_comma_cs_simps
+    )
+    fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+    then obtain a b f
+      where A_def: "A = [a, b, f]\<^sub>\<circ>"
+        and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+        and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+        and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+      by (elim cat_comma_ObjE[OF _ assms])
+    from a b f show 
+      "op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr> \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
+      unfolding A_def
+      by 
+        (
+          cs_concl 
+            cs_simp: cat_comma_cs_simps cat_op_simps 
+            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+        )
+  qed
+  show "(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
+  proof(intro vsubsetI)
+    fix B assume "B \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Obj\<rparr>"
+    then obtain a b f
+      where B_def: "B = [b, a, f]\<^sub>\<circ>"
+        and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+        and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+        and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+      by 
+        (
+          elim cat_comma_ObjE[
+            OF _ \<HH>.is_functor_op \<GG>.is_functor_op, unfolded cat_op_simps
+            ]
+        )
+    from a b f have B_def: "B = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a, b, f\<rparr>\<^sub>\<bullet>"
+      by 
+        (
+          cs_concl 
+            cs_simp: cat_comma_cs_simps B_def
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+    from a b f have "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
+      by 
+        (
+          cs_concl
+            cs_simp: cat_comma_cs_simps
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+    with op_cf_commma_obj_flip_vsv show "B \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_commma_obj_flip \<GG> \<HH>)"
+      unfolding B_def by auto
+  qed
+qed
+
+
+subsubsection\<open>Definition and elementary properties\<close>
+
+definition op_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V"
+  where "op_cf_comma \<GG> \<HH> =
+    [
+      op_cf_commma_obj_flip \<GG> \<HH>,
+      (
+        \<lambda>ABF\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Arr\<rparr>.
+          [
+            op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>,
+            op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>0\<rparr>\<rparr>,
+            [ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>
+          ]\<^sub>\<circ>
+      ),
+      op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>),
+      (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)
+    ]\<^sub>\<circ>"
+
+
+text\<open>Components.\<close>
+
+lemma op_cf_comma_components:
+  shows [cat_comma_cs_simps]: 
+      "op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr> = op_cf_commma_obj_flip \<GG> \<HH>"
+    and "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr> =
+      (
+        \<lambda>ABF\<in>\<^sub>\<circ>(\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Arr\<rparr>.
+          [
+            op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>,
+            op_cf_commma_obj_flip \<GG> \<HH>\<lparr>ABF\<lparr>0\<rparr>\<rparr>,
+            [ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, ABF\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<^sub>\<nat>\<rparr>]\<^sub>\<circ>
+          ]\<^sub>\<circ>
+      )"
+    and [cat_comma_cs_simps]: 
+      "op_cf_comma \<GG> \<HH>\<lparr>HomDom\<rparr> = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
+    and [cat_comma_cs_simps]: 
+      "op_cf_comma \<GG> \<HH>\<lparr>HomCod\<rparr> = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
+  unfolding op_cf_comma_def dghm_field_simps by (simp_all add: nat_omega_simps)
+
+
+subsubsection\<open>Arrow map\<close>
+
+mk_VLambda op_cf_comma_components(2)
+  |vsv op_cf_comma_ArrMap_vsv[cat_comma_cs_intros]|
+  |vdomain op_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]|
+  |app op_cf_comma_ArrMap_app'|
+
+lemma op_cf_comma_ArrMap_app[cat_comma_cs_simps]:
+  assumes "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
+    [
+      op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>,
+      op_cf_commma_obj_flip \<GG> \<HH>\<lparr>a, b, f\<rparr>\<^sub>\<bullet>,
+      [h, g]\<^sub>\<circ>
+    ]\<^sub>\<circ>"
+  using assms(2) by (simp add: assms(1) op_cf_comma_ArrMap_app' nat_omega_simps)
+
+lemma op_cf_comma_ArrMap_v11[cat_comma_cs_intros]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "v11 (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
+proof
+  (
+    rule vsv.vsv_valeq_v11I, 
+    unfold op_cf_comma_ArrMap_vdomain,
+    intro op_cf_comma_ArrMap_vsv
+  )
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  fix ABF ABF' assume prems:
+    "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+    "ABF' \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+    "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF'\<rparr>"
+  from prems(1) obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
+  from prems(2) obtain A' B' where ABF': "ABF' : A' \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B'" by auto
+  from ABF obtain a b f a' b' f' g h 
+    where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [a, b, f]\<^sub>\<circ>"
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
+      and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+      and "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
+      and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+      and "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+      and "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
+    by (elim cat_comma_is_arrE[OF _ assms])
+  from ABF' obtain a'' b'' f'' a''' b''' f''' g' h' 
+    where ABF'_def: "ABF' = [[a'', b'', f'']\<^sub>\<circ>, [a''', b''', f''']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+      and A'_def: "A' = [a'', b'', f'']\<^sub>\<circ>"
+      and B'_def: "B' = [a''', b''', f''']\<^sub>\<circ>"
+      and "g' : a'' \<mapsto>\<^bsub>\<AA>\<^esub> a'''"
+      and "h' : b'' \<mapsto>\<^bsub>\<BB>\<^esub> b'''"
+      and "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
+      and "f''' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'''\<rparr>"
+      and "f''' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
+    by (elim cat_comma_is_arrE[OF _ assms])
+  from ABF ABF' have abf:
+    "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
+    "[a', b', f']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
+    "[a'', b'', f'']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
+    "[a''', b''', f''']\<^sub>\<circ> \<in>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>"
+    unfolding ABF_def ABF'_def A_def B_def A'_def B'_def by auto
+  note v11_injective = v11.v11_injective[
+      OF op_cf_commma_obj_flip_v11, OF assms, unfolded cat_comma_cs_simps
+      ]
+  from 
+    prems(3,1,2) assms 
+    op_cf_commma_obj_flip_v11 
+    v11_injective[OF abf(1,3)] 
+    v11_injective[OF abf(2,4)] 
+  show "ABF = ABF'"
+    by 
+      (
+        simp_all add: 
+          ABF_def ABF'_def op_cf_comma_ArrMap_app' nat_omega_simps 
+      )
+qed
+
+lemma op_cf_comma_ArrMap_is_arr:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+  shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> :
+    op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr> \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub> 
+    op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr>"
+proof-
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> 
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms(3) obtain a b f a' b' f' g h
+    where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [a, b, f]\<^sub>\<circ>"
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
+      and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+      and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
+      and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+      and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+      and f'g_hf: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
+    by (elim cat_comma_is_arrE[OF _ assms(1,2)])
+  from g h f f' f'g_hf show ?thesis
+    unfolding ABF_def A_def B_def
+    by 
+      (
+        cs_concl 
+          cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+qed
+
+lemma op_cf_comma_ArrMap_is_arr':
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B"
+    and "A' = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>B\<rparr>"
+    and "B' = op_cf_commma_obj_flip \<GG> \<HH>\<lparr>A\<rparr>"
+  shows "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> : A' \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub> B'"
+  using assms(1-3) unfolding assms(4,5) by (intro op_cf_comma_ArrMap_is_arr)
+
+lemma op_cf_comma_ArrMap_vrange[cat_comma_cs_simps]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "\<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
+proof-
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  interpret op_\<GG>\<HH>: category \<alpha> \<open>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<close>
+    by (cs_concl cs_intro: cat_comma_cs_intros cat_op_intros)
+  show ?thesis
+  proof(intro vsubset_antisym)
+    show "\<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
+    proof
+      (
+        intro vsv.vsv_vrange_vsubset op_cf_comma_ArrMap_vsv, 
+        unfold cat_comma_cs_simps
+      )
+      fix ABF assume prems: "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
+      from op_cf_comma_ArrMap_is_arr[OF assms this] show 
+        "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
+        by auto
+    qed
+    show "(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
+    proof(intro vsubsetI)
+      fix ABF assume prems: "ABF \<in>\<^sub>\<circ> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>Arr\<rparr>"
+      then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub> B" 
+        by auto
+      then obtain a b f a' b' f' g h
+        where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+          and A_def: "A = [a, b, f]\<^sub>\<circ>"
+          and B_def: "B = [a', b', f']\<^sub>\<circ>"
+          and g: "g : a' \<mapsto>\<^bsub>\<BB>\<^esub> a"
+          and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+          and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>" 
+          and f'g_hf: "f' \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> \<HH>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f"
+        by 
+          (
+            elim cat_comma_is_arrE[
+              OF _ \<HH>.is_functor_op \<GG>.is_functor_op, unfolded cat_op_simps
+              ]
+          )
+      from f'g_hf g h f f' have gf'_fh:
+        "\<HH>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>"
+        by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
+      with g h f f' have 
+        "[[b', a', f']\<^sub>\<circ>, [b, a, f]\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
+        "ABF = op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>[b', a', f']\<^sub>\<circ>, [b, a, f]\<^sub>\<circ>, [h, g]\<^sub>\<circ>\<rparr>\<^sub>\<bullet>"
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps ABF_def
+              cs_intro: cat_cs_intros cat_comma_cs_intros
+          )+
+      with op_cf_comma_ArrMap_vsv show "ABF \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>)"
+        by auto
+    qed
+  qed
+qed
+
+
+subsubsection\<open>Opposite comma category functor is an isomorphism of categories\<close>
+
+lemma op_cf_comma_is_iso_functor:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "op_cf_comma \<GG> \<HH> : 
+    op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
+proof-
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  show ?thesis
+  proof(intro is_iso_functorI' is_functorI')
+    show "vfsequence (op_cf_comma \<GG> \<HH>)"
+      unfolding op_cf_comma_def by simp
+    show "vcard (op_cf_comma \<GG> \<HH>) = 4\<^sub>\<nat>"
+      unfolding op_cf_comma_def by (simp add: nat_omega_simps)
+    from assms show "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> :
+      op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub>
+      op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
+      if "ABF : A \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> B" for A B ABF
+      using that
+      unfolding cat_op_simps
+      by 
+        (
+          cs_concl
+            cs_intro: op_cf_comma_ArrMap_is_arr' cs_simp: cat_comma_cs_simps
+        )
+    show
+      "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> F\<rparr> =
+        op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>(op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<^esub>
+          op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      if "G : B \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> C" 
+        and "F : A \<mapsto>\<^bsub>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<^esub> B"
+      for B C G A F
+    proof-
+      note G = that(1)[unfolded cat_op_simps]
+      note F = that(2)[unfolded cat_op_simps]
+      from assms G obtain a b f a' b' f' g h
+        where G_def: "G = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+          and C_def: "C = [a, b, f]\<^sub>\<circ>"
+          and B_def: "B = [a', b', f']\<^sub>\<circ>"
+          and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+          and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+          and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+          and [symmetric, cat_comma_cs_simps]: 
+            "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
+        by auto
+      with assms F obtain a'' b'' f'' g' h'
+        where F_def: "F = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+          and A_def: "A = [a'', b'', f'']\<^sub>\<circ>"
+          and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
+          and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
+          and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
+          and [cat_comma_cs_simps]: 
+            "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
+        by auto (*slow*)
+      note [cat_comma_cs_simps] = 
+        category.cat_assoc_helper[
+          where \<CC>=\<CC> and h=f'' and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
+          ]
+      from assms that g h f f' g' h' f' f'' show ?thesis
+        unfolding cat_op_simps G_def C_def B_def F_def A_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed
+    show 
+      "op_cf_comma \<GG> \<HH>\<lparr>ArrMap\<rparr>\<lparr>op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
+        (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)\<lparr>CId\<rparr>\<lparr>op_cf_comma \<GG> \<HH>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
+      if "C \<in>\<^sub>\<circ> op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)\<lparr>Obj\<rparr>" for C
+    proof-
+      from that[unfolded cat_op_simps] assms obtain a b f 
+        where C_def: "C = [a, b, f]\<^sub>\<circ>"
+          and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+          and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+        by auto
+      from a b f that show ?thesis
+        unfolding cat_op_simps C_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed
+  qed
+    (
+      cs_concl
+        cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+        cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_op_intros
+    )+
+qed
+
+lemma op_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "\<AA>' = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
+    and "\<BB>' = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
+  shows "op_cf_comma \<GG> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_iso_functor)
+
+lemma op_cf_comma_is_functor:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "op_cf_comma \<GG> \<HH> :
+    op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
+  by (rule is_iso_functorD(1)[OF op_cf_comma_is_iso_functor[OF assms]])
+
+lemma op_cf_comma_is_functor'[cat_comma_cs_intros]:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "\<AA>' = op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>)"
+    and "\<BB>' = (op_cf \<HH>) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (op_cf \<GG>)"
+  shows "op_cf_comma \<GG> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_functor)
+
+
+
 subsection\<open>Projections for a comma category\<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 
 text\<open>See Chapter II-6 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_comma_proj_left :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<Sqinter> _)\<close> [1000, 1000] 999)
   where "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>0\<rparr>),
       (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>),
       \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>,
       \<GG>\<lparr>HomDom\<rparr>
     ]\<^sub>\<circ>"
 
 definition cf_comma_proj_right :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<Sqinter>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
   where "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>1\<^sub>\<nat>\<rparr>),
       (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>),
       \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>,
       \<HH>\<lparr>HomDom\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_comma_proj_left_components:
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>0\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>)"
     and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>HomDom\<rparr> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
     and "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomDom\<rparr>"
   unfolding cf_comma_proj_left_def dghm_field_simps
   by (simp_all add: nat_omega_simps)
 
 lemma cf_comma_proj_right_components:
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>. a\<lparr>1\<^sub>\<nat>\<rparr>)"
     and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>. f\<lparr>2\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>)"
     and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>HomDom\<rparr> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
     and "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>HomCod\<rparr> = \<HH>\<lparr>HomDom\<rparr>"
   unfolding cf_comma_proj_right_def dghm_field_simps
   by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<AA> \<BB> \<CC> \<GG> \<HH>
   assumes \<GG>: "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<HH>: "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule \<GG>)
 interpretation \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule \<HH>)
 
 lemmas cf_comma_proj_left_components' = 
   cf_comma_proj_left_components[of \<GG> \<HH>, unfolded \<GG>.cf_HomDom]
 
 lemmas cf_comma_proj_right_components' = 
   cf_comma_proj_right_components[of \<GG> \<HH>, unfolded \<HH>.cf_HomDom]
 
 lemmas [cat_comma_cs_simps] = 
   cf_comma_proj_left_components'(3,4)
   cf_comma_proj_right_components'(3,4)
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda cf_comma_proj_left_components(1)
   |vsv cf_comma_proj_left_ObjMap_vsv[cat_comma_cs_intros]|
   |vdomain cf_comma_proj_left_ObjMap_vdomain[cat_comma_cs_simps]|
 
 mk_VLambda cf_comma_proj_right_components(1)
   |vsv cf_comma_proj_right_ObjMap_vsv[cat_comma_cs_intros]|
   |vdomain cf_comma_proj_right_ObjMap_vdomain[cat_comma_cs_simps]|
 
 lemma cf_comma_proj_left_ObjMap_app[cat_comma_cs_simps]:
   assumes "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
   using assms(2) unfolding assms(1) cf_comma_proj_left_components by simp
 
 lemma cf_comma_proj_right_ObjMap_app[cat_comma_cs_simps]:
   assumes "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = b"
   using assms(2)
   unfolding assms(1) cf_comma_proj_right_components 
   by (simp add: nat_omega_simps)
 
 lemma cf_comma_proj_left_ObjMap_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
   fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   with assms obtain a b f where A_def: "A = [a, b, f]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     by auto
   from assms prems a show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
 qed (auto intro: cat_comma_cs_intros)  
 
 lemma cf_comma_proj_right_ObjMap_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
   fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
   with assms obtain a b f where A_def: "A = [a, b, f]\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     by auto
   from assms prems b show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
 qed (auto intro: cat_comma_cs_intros)  
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda cf_comma_proj_left_components(2)
   |vsv cf_comma_proj_left_ArrMap_vsv[cat_comma_cs_intros]|
   |vdomain cf_comma_proj_left_ArrMap_vdomain[cat_comma_cs_simps]|
 
 mk_VLambda cf_comma_proj_right_components(2)
   |vsv cf_comma_proj_right_ArrMap_vsv[cat_comma_cs_intros]|
   |vdomain cf_comma_proj_right_ArrMap_vdomain[cat_comma_cs_simps]|
 
 lemma cf_comma_proj_left_ArrMap_app[cat_comma_cs_simps]:
-  assumes "A = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
-    and "[abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> = g"
+  assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>" and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = g"
   using assms(2)
   unfolding assms(1) cf_comma_proj_left_components 
   by (simp add: nat_omega_simps)
 
 lemma cf_comma_proj_right_ArrMap_app[cat_comma_cs_simps]:
-  assumes "A = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
-    and "[abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> = h"
+  assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
+    and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+  shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = h"
   using assms(2)
   unfolding assms(1) cf_comma_proj_right_components 
   by (simp add: nat_omega_simps)
 
 lemma cf_comma_proj_left_ArrMap_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
   from assms interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  then obtain abf a'b'f' where "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'" by auto
+  then obtain A B where "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
   with assms obtain a b f a' b' f' g h
     where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     by auto
   from assms prems g show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     unfolding F_def 
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
 qed (auto intro: cat_comma_cs_intros)  
 
 lemma cf_comma_proj_right_ArrMap_vrange:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
   from assms interpret category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   fix F assume prems: "F \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
-  then obtain abf a'b'f' where F: "F : abf \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> a'b'f'" by auto
+  then obtain A B where F: "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
   with assms obtain a b f a' b' f' g h
     where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
       and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
     by auto
   from assms prems h show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
     unfolding F_def 
     by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
 qed (auto intro: cat_comma_cs_intros)  
 
 
 subsubsection\<open>Projections for a comma category are functors\<close>
 
 lemma cf_comma_proj_left_is_functor:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
   from assms interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   show ?thesis
   proof(rule is_functorI')
     show "vfsequence (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)"
       unfolding cf_comma_proj_left_def by auto
     show "vcard (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = 4\<^sub>\<nat>"
       unfolding cf_comma_proj_left_def by (simp add: nat_omega_simps)
     from assms show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       by (rule cf_comma_proj_left_ObjMap_vrange)
     show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
       if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
     proof-
       from assms that obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [a, b, f]\<^sub>\<circ>"
           and B_def: "B = [a', b', f']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
         by auto
       from that g show 
         "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
         unfolding F_def A_def B_def
         by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
     qed
     show 
       "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F\<rparr> =
         \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
       if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for B C G A F
     proof-
       from assms that(2) obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [a, b, f]\<^sub>\<circ>"
           and B_def: "B = [a', b', f']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
           and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
         by auto
       with that(1) assms obtain a'' b'' f'' g' h'
         where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
           and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
           and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
           and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
           and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
           and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
         by auto (*slow*)
       note [cat_cs_simps] = 
         category.cat_assoc_helper
           [
             where \<CC>=\<CC> 
               and h=f'' 
               and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> 
               and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
           ]
         category.cat_assoc_helper
           [
             where \<CC>=\<CC> 
               and h=f 
               and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close> 
               and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
           ]
       from assms that g g' h h' f f' f'' show ?thesis
         unfolding F_def G_def A_def B_def C_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps
               cs_intro: cat_comma_cs_intros cat_cs_intros
           )
     qed
     show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>\<rparr>"
       if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
     proof-
       from assms that obtain a b f 
         where A_def: "A = [a, b, f]\<^sub>\<circ>"
           and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by auto
       from assms that this(2-4) show ?thesis
         unfolding A_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps 
               cs_intro: cat_comma_cs_intros cat_cs_intros
           )
     qed
   qed 
     (
       use assms in 
         \<open>
           cs_concl
             cs_simp: cat_comma_cs_simps
             cs_intro: cat_cs_intros cat_comma_cs_intros
         \<close>
     )+
 qed
 
 lemma cf_comma_proj_left_is_functor'[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<AA>' = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_functor)
 
 lemma cf_comma_proj_right_is_functor:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
   from assms interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   show ?thesis
   proof(rule is_functorI')
     show "vfsequence (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)"
       unfolding cf_comma_proj_right_def by auto
     show "vcard (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = 4\<^sub>\<nat>"
       unfolding cf_comma_proj_right_def by (simp add: nat_omega_simps)
     from assms show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by (rule cf_comma_proj_right_ObjMap_vrange)
     show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
       if "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for A B F
     proof-
       from assms that obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [a, b, f]\<^sub>\<circ>"
           and B_def: "B = [a', b', f']\<^sub>\<circ>"
           and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
         by auto
       from that h show 
         "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
         unfolding F_def A_def B_def
         by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
     qed
     show 
       "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> F\<rparr> =
         \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
       if "G : B \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" for B C G A F
     proof-
       from assms that(2) obtain a b f a' b' f' g h
         where F_def: "F = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [a, b, f]\<^sub>\<circ>"
           and B_def: "B = [a', b', f']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
           and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
         by auto
       with that(1) assms obtain a'' b'' f'' g' h'
         where G_def: "G = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
           and C_def: "C = [a'', b'', f'']\<^sub>\<circ>"
           and g': "g' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
           and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
           and f'': "f'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
           and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
         by auto (*slow*)
       note [cat_cs_simps] = 
         category.cat_assoc_helper
           [
             where \<CC>=\<CC> 
               and h=f'' 
               and g=\<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>\<close> 
               and q=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<close>
           ]
         category.cat_assoc_helper
           [
             where \<CC>=\<CC> 
               and h=f 
               and g=\<open>\<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr>\<close> 
               and q=\<open>f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
           ]
       from assms that g g' h h' f f' f'' show ?thesis
         unfolding F_def G_def A_def B_def C_def
         by 
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps 
               cs_intro: cat_comma_cs_intros cat_cs_intros
           )
     qed
     show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>\<lparr>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>CId\<rparr>\<lparr>A\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>\<rparr>"
       if "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>" for A
     proof-
       from assms that obtain a b f 
         where A_def: "A = [a, b, f]\<^sub>\<circ>"
           and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by auto
       from assms that this(2-4) show ?thesis
         unfolding A_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps
               cs_intro: cat_comma_cs_intros cat_cs_intros
           )
     qed
   qed 
     (
       use assms in
         \<open>
           cs_concl
             cs_simp: cat_comma_cs_simps
             cs_intro: cat_cs_intros cat_comma_cs_intros
         \<close>
     )+
 qed
 
 lemma cf_comma_proj_right_is_functor'[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<AA>' = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_functor)
 
 
+subsubsection\<open>Opposite projections for a comma category\<close>
+
+lemma op_cf_comma_proj_left: 
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = (op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
+proof-
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) = (op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
+  proof(rule cf_eqI)
+    show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>) : op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
+      by 
+        (
+          cs_concl cs_simp: cs_intro: 
+            cat_cs_intros cat_comma_cs_intros cat_op_intros
+        )
+    then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      by (cs_concl cs_simp: cat_comma_cs_simps cat_op_simps)+
+    show "(op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH> :
+      op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
+      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
+    then have ObjMap_dom_rhs:
+      "\<D>\<^sub>\<circ> (((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>) =
+        \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and ArrMap_dom_rhs: 
+        "\<D>\<^sub>\<circ> (((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>) =
+          \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
+    show
+      "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr> =
+        ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>"
+    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+      fix A assume "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      with assms obtain a b f 
+        where A_def: "A = [a, b, f]\<^sub>\<circ>"
+          and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+          and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+        by auto
+      from a b f show 
+        "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
+          ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+        unfolding A_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed
+      (
+        cs_concl
+          cs_simp: cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )+
+    show 
+      "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr> =
+        ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
+    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+      fix ABF assume "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      then obtain A B where "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
+      with assms obtain a b f a' b' f' g h
+        where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+          and A_def: "A = [a, b, f]\<^sub>\<circ>"
+          and B_def: "B = [a', b', f']\<^sub>\<circ>"
+          and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+          and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+          and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+          and [symmetric, cat_cs_simps]: 
+            "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
+        by auto
+      from g h f f' show "op_cf (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
+        ((op_cf \<HH>) \<Sqinter>\<^sub>C\<^sub>F (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr>"
+        unfolding ABF_def A_def B_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed 
+      (
+        cs_concl
+          cs_simp: cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )+
+  qed simp_all
+qed
+
+lemma op_cf_comma_proj_right:
+  assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  shows "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
+proof-
+  interpret \<GG>: is_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
+  interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
+  interpret \<GG>\<HH>: category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close>
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) = (op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>"
+  proof(rule cf_eqI)
+    show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>) : op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
+      by 
+        (
+          cs_concl cs_simp: cs_intro: 
+            cat_cs_intros cat_comma_cs_intros cat_op_intros
+        )
+    then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr>) = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      by (cs_concl cs_simp: cat_comma_cs_simps cat_op_simps)+
+    show "(op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH> :
+      op_cat (\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
+      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
+    then have ObjMap_dom_rhs:
+      "\<D>\<^sub>\<circ> (((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>) =
+        \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      and ArrMap_dom_rhs:
+        "\<D>\<^sub>\<circ> (((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>) =
+          \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
+    show
+      "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr> =
+        ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>"
+    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+      fix A assume prems: "A \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Obj\<rparr>"
+      with assms obtain a b f 
+        where A_def: "A = [a, b, f]\<^sub>\<circ>"
+          and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+          and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+        by auto
+      from a b f show
+        "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
+          ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+        unfolding A_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed
+      (
+        cs_concl
+          cs_simp: cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )+
+    show 
+      "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr> =
+        ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>"
+    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+      fix ABF assume prems: "ABF \<in>\<^sub>\<circ> \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<lparr>Arr\<rparr>"
+      then obtain A B where ABF: "ABF : A \<mapsto>\<^bsub>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<^esub> B" by auto
+      with assms obtain a b f a' b' f' g h
+        where ABF_def: "ABF = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+          and A_def: "A = [a, b, f]\<^sub>\<circ>"
+          and B_def: "B = [a', b', f']\<^sub>\<circ>"
+          and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+          and h: "h : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
+          and f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+          and f': "f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+          and [symmetric, cat_cs_simps]: 
+            "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<HH>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
+        by auto
+      from g h f f' show "op_cf (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> =
+        ((op_cf \<HH>) \<^sub>C\<^sub>F\<Sqinter> (op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf_comma \<GG> \<HH>)\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr>"
+        unfolding ABF_def A_def B_def
+        by
+          (
+            cs_concl
+              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+          )
+    qed 
+      (
+        cs_concl
+          cs_simp: cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )+
+  qed simp_all
+qed
+
+
 subsubsection\<open>Projections for a tiny comma category\<close>
 
 lemma cf_comma_proj_left_is_tm_functor:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
 proof(intro is_tm_functorI')
 
   interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
 
   show \<Pi>_\<GG>\<HH>: "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
 
   interpret \<Pi>_\<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<AA> \<open>\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<close>
     by (rule \<Pi>_\<GG>\<HH>)
   interpret \<GG>\<HH>: tiny_category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> 
     by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)
 
   show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
   proof(rule vbrelation.vbrelation_Limit_in_VsetI)
     show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof-
       note \<Pi>_\<GG>\<HH>.cf_ObjMap_vrange
       moreover have "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
       ultimately show ?thesis by auto
     qed
   qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)
 
   show "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
   proof(rule vbrelation.vbrelation_Limit_in_VsetI)
     show "\<R>\<^sub>\<circ> (\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof-
       note \<Pi>_\<GG>\<HH>.cf_ArrMap_vrange
       moreover have "\<AA>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
       ultimately show ?thesis by auto
     qed
   qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)
 
 qed
 
 lemma cf_comma_proj_left_is_tm_functor'[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG>\<HH> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
   shows "\<GG> \<^sub>C\<^sub>F\<Sqinter> \<HH> : \<GG>\<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_tm_functor)
 
 lemma cf_comma_proj_right_is_tm_functor:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
 proof(intro is_tm_functorI')
 
   interpret \<GG>: is_tm_functor \<alpha> \<AA> \<CC> \<GG> by (rule assms(1))
   interpret \<HH>: is_tm_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(2))
 
   show \<Pi>_\<GG>\<HH>: "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
 
   interpret \<Pi>_\<GG>\<HH>: is_functor \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> \<BB> \<open>\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<close>
     by (rule \<Pi>_\<GG>\<HH>)
   interpret \<GG>\<HH>: tiny_category \<alpha> \<open>\<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>\<close> 
     by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)
 
   show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
   proof(rule vbrelation.vbrelation_Limit_in_VsetI)
     show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof-
       note \<Pi>_\<GG>\<HH>.cf_ObjMap_vrange
       moreover have "\<BB>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
       ultimately show ?thesis by auto
     qed
   qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)
 
   show "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
   proof(rule vbrelation.vbrelation_Limit_in_VsetI)
     show "\<R>\<^sub>\<circ> (\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof-
       note \<Pi>_\<GG>\<HH>.cf_ArrMap_vrange
       moreover have "\<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro cat_small_cs_intros)
       ultimately show ?thesis by auto
     qed
   qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)
 
 qed
 
 lemma cf_comma_proj_right_is_tm_functor'[cat_comma_cs_intros]:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG>\<HH> = \<GG> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<HH>"
   shows "\<GG> \<Sqinter>\<^sub>C\<^sub>F \<HH> : \<GG>\<HH> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_tm_functor)
 
 
 
 subsection\<open>Comma categories constructed from a functor and an object\<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 
 text\<open>See Chapter II-6 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cat_cf_obj_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<down> _)\<close> [1000, 1000] 999)
   where "\<FF> \<^sub>C\<^sub>F\<down> b \<equiv> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"
 
 definition cat_obj_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
   where "b \<down>\<^sub>C\<^sub>F \<FF> \<equiv> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>"
 
 
 text\<open>Alternative forms of the definitions.\<close>
 
 lemma (in is_functor) cat_cf_obj_comma_def:
   "\<FF> \<^sub>C\<^sub>F\<down> b = \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)" 
   unfolding cat_cf_obj_comma_def cf_HomCod ..
 
 lemma (in is_functor) cat_obj_cf_comma_def:
   "b \<down>\<^sub>C\<^sub>F \<FF> = (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>" 
   unfolding cat_obj_cf_comma_def cf_HomCod ..
 
 
 subsubsection\<open>Objects\<close>
 
 lemma (in is_functor) cat_cf_obj_comma_ObjI[cat_comma_cs_intros]:
   assumes "A = [a, 0, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
   shows "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   using assms(2,3)
   unfolding assms(1)
   by
     (
       cs_concl 
         cs_simp: cat_cs_simps cat_cf_obj_comma_def 
         cs_intro: cat_cs_intros vempty_is_zet cat_comma_ObjI
     )
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ObjI
 
 lemma (in is_functor) cat_obj_cf_comma_ObjI[cat_comma_cs_intros]:
   assumes "A = [0, a, f]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
   shows "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   using assms(2,3)
   unfolding assms(1)
   by
     (
       cs_concl 
         cs_simp: cat_cs_simps cat_obj_cf_comma_def 
         cs_intro: vempty_is_zet cat_cs_intros cat_comma_ObjI
     )
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ObjI
 
 lemma (in is_functor) cat_cf_obj_comma_ObjD[dest]:
   assumes "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-    and "b' = 0" 
-    and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+  shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b' = 0" and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
 proof-
   from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   note obj = cat_comma_ObjD[
       OF assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
       ]
   from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
   moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   ultimately show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b' = 0" "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     using obj by auto
 qed
 
 lemmas [dest] = is_functor.cat_cf_obj_comma_ObjD[rotated 1]
 
 lemma (in is_functor) cat_obj_cf_comma_ObjD[dest]:
   assumes "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-    and "b' = 0" 
-    and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+  shows "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b' = 0" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
 proof-
   from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   note obj = cat_comma_ObjD[
       OF assms(1)[unfolded cat_obj_cf_comma_def] this is_functor_axioms
       ]
   from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
   moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   ultimately show "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b' = 0" "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     using obj by auto
 qed
 
 lemmas [dest] = is_functor.cat_obj_cf_comma_ObjD[rotated 1]
 
 lemma (in is_functor) cat_cf_obj_comma_ObjE[elim]:
   assumes "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  obtains a f where "A = [a, 0, f]\<^sub>\<circ>" 
-    and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-    and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+  obtains a f 
+    where "A = [a, 0, f]\<^sub>\<circ>" 
+      and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+      and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
 proof-
   from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this 
   obtain a b' f 
     where "A = [a, b', f]\<^sub>\<circ>"
       and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       and b': "b' \<in>\<^sub>\<circ> cat_1 0 0\<lparr>Obj\<rparr>" 
       and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     by auto
   moreover from b' have [cat_cs_simps]: "b' = 0"
     unfolding cat_1_components by auto
   moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   ultimately show ?thesis using that by auto
 qed
 
 lemmas [elim] = is_functor.cat_cf_obj_comma_ObjE[rotated 1]
 
 lemma (in is_functor) cat_obj_cf_comma_ObjE[elim]:
   assumes "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  obtains a f where "A = [0, a, f]\<^sub>\<circ>"
-    and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-    and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+  obtains a f 
+    where "A = [0, a, f]\<^sub>\<circ>"
+      and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+      and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
 proof-
   from assms(2) have "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from assms(1)[unfolded cat_obj_cf_comma_def] is_functor_axioms this 
   obtain a b' f 
     where A_def: "A = [b', a, f]\<^sub>\<circ>"
       and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       and b': "b' \<in>\<^sub>\<circ> cat_1 0 0\<lparr>Obj\<rparr>" 
       and f: "f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     by auto
   moreover from b' have [cat_cs_simps]: "b' = 0" 
     unfolding cat_1_components by auto
   moreover have "cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> = b"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   ultimately show ?thesis using that by auto
 qed
 
 lemmas [elim] = is_functor.cat_obj_cf_comma_ObjE[rotated 1]
 
 
 subsubsection\<open>Arrows\<close>
 
 lemma (in is_functor) cat_cf_obj_comma_ArrI[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
-    and "F = [abf, a'b'f', [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "abf = [a, 0, f]\<^sub>\<circ>"
-    and "a'b'f' = [a', 0, f']\<^sub>\<circ>"
+    and "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "A = [a, 0, f]\<^sub>\<circ>"
+    and "B = [a', 0, f']\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
   shows "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
   unfolding cat_cf_obj_comma_def
 proof(intro cat_comma_ArrI cat_comma_HomI)
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: cat_cs_intros)
   from assms(1) show const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from vempty_is_zet show 0: "0 : 0 \<mapsto>\<^bsub>cat_1 0 0\<^esub> 0"
     by (cs_concl cs_simp: cat_cs_simps cat_1_CId_app cs_intro: cat_cs_intros)
   from assms(6) show 
     "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(7) show 
     "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from 0 assms(6) show 
     "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>0\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
     by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
-  from const assms(5,6) show 
-    "abf \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (dghm_const (cat_1 []\<^sub>\<circ> []\<^sub>\<circ>) \<BB> b (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>))\<lparr>Obj\<rparr>"
+  from const assms(5,6) show "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
     by (fold cat_cf_obj_comma_def)
       (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
-  from const assms(5,7) show 
-    "a'b'f' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (dghm_const (cat_1 []\<^sub>\<circ> []\<^sub>\<circ>) \<BB> b (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>))\<lparr>Obj\<rparr>"
+  from const assms(5,7) show "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
     by (fold cat_cf_obj_comma_def)
       (cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
 qed (intro assms)+
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ArrI
 
 lemma (in is_functor) cat_obj_cf_comma_ArrI[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
-    and "F = [abf, a'b'f', [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "abf = [0, a, f]\<^sub>\<circ>"
-    and "a'b'f' = [0, a', f']\<^sub>\<circ>"
+    and "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "A = [0, a, f]\<^sub>\<circ>"
+    and "B = [0, a', f']\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> "
     and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
   shows "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
   unfolding cat_obj_cf_comma_def
 proof(intro cat_comma_ArrI cat_comma_HomI)
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: cat_cs_intros)
   from assms(1) show const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from vempty_is_zet show 0: "0 : 0 \<mapsto>\<^bsub>cat_1 0 0\<^esub> 0"
     by (cs_concl cs_simp: cat_1_CId_app cs_intro: cat_cs_intros)
   from assms(6) show 
     "f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(7) show 
     "f' : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>0\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from 0 assms(7) show 
     "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>0\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
     by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
-  from const assms(5,6) show 
-    "abf \<in>\<^sub>\<circ> (dghm_const (cat_1 0 0) \<BB> b (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  from const assms(5,6) show "A \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by (fold cat_obj_cf_comma_def)
       (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
-  from const assms(5,7) show 
-    "a'b'f' \<in>\<^sub>\<circ> (dghm_const (cat_1 []\<^sub>\<circ> []\<^sub>\<circ>) \<BB> b (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  from const assms(5,7) show "B \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by (fold cat_obj_cf_comma_def)
       (cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
 qed (intro assms)+
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ArrI
 
 lemma (in is_functor) cat_cf_obj_comma_ArrE[elim]:
   assumes "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  obtains abf a'b'f' a f a' f' g
-    where "F = [abf, a'b'f', [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, 0, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', 0, f']\<^sub>\<circ>"
+  obtains A B a f a' f' g
+    where "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, 0, f]\<^sub>\<circ>"
+      and "B = [a', 0, f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
-      and "abf \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
-      and "a'b'f' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+      and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+      and "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
 proof-
   from cat_comma_ArrE[OF assms(1)[unfolded cat_cf_obj_comma_def]] 
-  obtain abf a'b'f' 
-    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom \<FF> (cf_const (cat_1 0 0) \<BB> b) abf a'b'f'"
-      and abf: "abf \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
-      and a'b'f': "a'b'f' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
+  obtain A B 
+    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom \<FF> (cf_const (cat_1 0 0) \<BB> b) A B"
+      and A: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
+      and B: "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F (cf_const (cat_1 0 0) \<BB> b)\<lparr>Obj\<rparr>"
     by auto
   from assms(2) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from F obtain a b'' f a' b' f' g h
-    where F_def: "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-      and abf_def: "abf = [a, b'', f]\<^sub>\<circ>"
-      and a'b'f'_def: "a'b'f' = [a', b', f']\<^sub>\<circ>"
+    where F_def: "F = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [a, b'', f]\<^sub>\<circ>"
+      and B_def: "B = [a', b', f']\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and h: "h : b'' \<mapsto>\<^bsub>cat_1 0 0\<^esub> b'"
       and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
       and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and f_def: 
         "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
     by (elim cat_comma_HomE[OF _ is_functor_axioms const]) blast
   note hb'b'' = cat_1_is_arrD[OF h]
-  from F_def have F_def: "F = [abf, a'b'f', [g, 0]\<^sub>\<circ>]\<^sub>\<circ>" 
+  from F_def have F_def: "F = [A, B, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>" 
     unfolding hb'b'' by simp
-  from abf_def have abf_def: "abf = [a, 0, f]\<^sub>\<circ>"
+  from A_def have A_def: "A = [a, 0, f]\<^sub>\<circ>"
     unfolding hb'b'' by simp
-  from a'b'f'_def have a'b'f'_def: "a'b'f' = [a', 0, f']\<^sub>\<circ>"
+  from B_def have B_def: "B = [a', 0, f']\<^sub>\<circ>"
     unfolding hb'b'' by simp
   from f have f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from f' have f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from f_def f f' g h have f_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from 
-    that F_def abf_def a'b'f'_def g f f' f_def  
-    a'b'f'[folded cat_cf_obj_comma_def] abf[folded cat_cf_obj_comma_def]
+    that F_def A_def B_def g f f' f_def  
+    B[folded cat_cf_obj_comma_def] A[folded cat_cf_obj_comma_def]
   show ?thesis
     by blast
 qed
 
 lemmas [elim] = is_functor.cat_cf_obj_comma_ArrE[rotated 1]
 
 lemma (in is_functor) cat_obj_cf_comma_ArrE[elim]:
   assumes "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  obtains baf b'a'f' a f a' f' g
-    where "F = [baf, b'a'f', [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "baf = [0, a, f]\<^sub>\<circ>"
-      and "b'a'f' = [0, a', f']\<^sub>\<circ>"
+  obtains A B a f a' f' g
+    where "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [0, a, f]\<^sub>\<circ>"
+      and "B = [0, a', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
-      and "baf \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      and "b'a'f' \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and "B \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof-
   from cat_comma_ArrE[OF assms(1)[unfolded cat_obj_cf_comma_def]] 
-  obtain baf b'a'f' 
-    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom (cf_const (cat_1 0 0) \<BB> b) \<FF> baf b'a'f'"
-      and baf: "baf \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      and b'a'f': "b'a'f' \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  obtain A B 
+    where F: "F \<in>\<^sub>\<circ> cat_comma_Hom (cf_const (cat_1 0 0) \<BB> b) \<FF> A B"
+      and A: "A \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and B: "B \<in>\<^sub>\<circ> (cf_const (cat_1 0 0) \<BB> b) \<^sub>C\<^sub>F\<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by auto
   from assms(2) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from F obtain a b'' f a' b' f' h g 
-    where F_def: "F = [baf, b'a'f', [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
-      and baf_def: "baf = [b', a, f]\<^sub>\<circ>"
-      and b'a'f'_def: "b'a'f' = [b'', a', f']\<^sub>\<circ>"
+    where F_def: "F = [A, B, [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
+      and A_def: "A = [b', a, f]\<^sub>\<circ>"
+      and B_def: "B = [b'', a', f']\<^sub>\<circ>"
       and h: "h : b' \<mapsto>\<^bsub>cat_1 0 0\<^esub> b''"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and f: "f : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       and f': "f' : cf_const (cat_1 0 0) \<BB> b\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       and f'_def: 
         "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> cf_const (cat_1 0 0) \<BB> b\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
     by (elim cat_comma_HomE[OF _ const is_functor_axioms]) blast
   note hb'b'' = cat_1_is_arrD[OF h]
-  from F_def have F_def: "F = [baf, b'a'f', [0, g]\<^sub>\<circ>]\<^sub>\<circ>" 
+  from F_def have F_def: "F = [A, B, [0, g]\<^sub>\<circ>]\<^sub>\<circ>" 
     unfolding hb'b'' by simp
-  from baf_def have baf_def: "baf = [0, a, f]\<^sub>\<circ>" 
-    unfolding hb'b'' by simp
-  from b'a'f'_def have b'a'f'_def: "b'a'f' = [0, a', f']\<^sub>\<circ>"
-    unfolding hb'b'' by simp
+  from A_def have A_def: "A = [0, a, f]\<^sub>\<circ>" unfolding hb'b'' by simp
+  from B_def have B_def: "B = [0, a', f']\<^sub>\<circ>" unfolding hb'b'' by simp
   from f have f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from f' have f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from f'_def f f' g h have f'_def[symmetric]: "f' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f"
     unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from 
-    that F_def baf_def b'a'f'_def g f f' f'_def  
-    baf[folded cat_obj_cf_comma_def] b'a'f'[folded cat_obj_cf_comma_def] 
+    that F_def A_def B_def g f f' f'_def  
+    A[folded cat_obj_cf_comma_def] B[folded cat_obj_cf_comma_def] 
   show ?thesis
     by blast
 qed
 
 lemmas [elim] = is_functor.cat_obj_cf_comma_ArrE
 
 lemma (in is_functor) cat_cf_obj_comma_ArrD[dest]: 
   assumes "[[a, b', f]\<^sub>\<circ>, [a', b'', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "b' = 0"
     and "b'' = 0"
     and "h = 0"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
     and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
     and "[a', b'', f']\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   using cat_cf_obj_comma_ArrE[OF assms] by auto
 
 lemmas [dest] = is_functor.cat_cf_obj_comma_ArrD[rotated 1]
 
 lemma (in is_functor) cat_obj_cf_comma_ArrD[dest]: 
   assumes "[[b', a, f]\<^sub>\<circ>, [b'', a', f']\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "b' = 0"
     and "b'' = 0"
     and "h = 0"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
     and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
     and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     and "[b'', a', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   using cat_obj_cf_comma_ArrE[OF assms] by auto
 
 lemmas [dest] = is_functor.cat_obj_cf_comma_ArrD
 
 
 subsubsection\<open>Domain\<close>
 
 lemma cat_cf_obj_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>)"
   unfolding cat_cf_obj_comma_def cat_comma_components by simp
 
 lemma cat_cf_obj_comma_Dom_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
   unfolding cat_cf_obj_comma_def cat_comma_components by simp
 
 lemma cat_cf_obj_comma_Dom_app[cat_comma_cs_simps]:
-  assumes "F = [abf, a'b'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
-  shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>F\<rparr> = abf"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
   using assms(2) 
   unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
   by simp
 
 lemma (in is_functor) cat_cf_obj_comma_Dom_vrange:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
 proof-  
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Dom_vrange[
           OF is_functor_axioms const, folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma cat_obj_cf_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>)"
   unfolding cat_obj_cf_comma_def cat_comma_components by simp
 
 lemma cat_obj_cf_comma_Dom_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
   unfolding cat_obj_cf_comma_def cat_comma_components by simp
 
 lemma cat_obj_cf_comma_Dom_app[cat_comma_cs_simps]:
-  assumes "F = [baf, b'a'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-  shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>F\<rparr> = baf"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A"
   using assms(2)
   unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
   by simp
 
 lemma (in is_functor) cat_obj_cf_comma_Dom_vrange:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof-  
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Dom_vrange[
           OF const is_functor_axioms, folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 
 subsubsection\<open>Codomain\<close>
 
 lemma cat_cf_obj_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>)"
   unfolding cat_cf_obj_comma_def cat_comma_components by simp
 
 lemma cat_cf_obj_comma_Cod_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
   unfolding cat_cf_obj_comma_def cat_comma_components by simp
 
 lemma cat_cf_obj_comma_Cod_app[cat_comma_cs_simps]:
-  assumes "F = [abf, a'b'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
-  shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>F\<rparr> = a'b'f'"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
   using assms(2) 
   unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
   by (simp add: nat_omega_simps)
 
 lemma (in is_functor) cat_cf_obj_comma_Cod_vrange:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
 proof-  
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Cod_vrange[
           OF is_functor_axioms const, folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma cat_obj_cf_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>)"
   unfolding cat_obj_cf_comma_def cat_comma_components by simp
 
 lemma cat_obj_cf_comma_Cod_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
   unfolding cat_obj_cf_comma_def cat_comma_components by simp
 
 lemma cat_obj_cf_comma_Cod_app[cat_comma_cs_simps]:
-  assumes "F = [baf, b'a'f', gh]\<^sub>\<circ>" and "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-  shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>F\<rparr> = b'a'f'"
+  assumes "ABF = [A, B, F]\<^sub>\<circ>" and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
   using assms(2)
   unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
   by (simp add: nat_omega_simps)
 
 lemma (in is_functor) cat_obj_cf_comma_Cod_vrange:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof-  
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Dom_vrange[
           OF const is_functor_axioms, folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow with a domain and a codomain\<close>
 
 lemma (in is_functor) cat_cf_obj_comma_is_arrI[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-    and "F = [abf, a'b'f', gh]\<^sub>\<circ>"
-    and "abf = [a, 0, f]\<^sub>\<circ>"
-    and "a'b'f' = [a', 0, f']\<^sub>\<circ>"
-    and "gh = [g, 0]\<^sub>\<circ>"
+    and "ABF = [A, B, F]\<^sub>\<circ>"
+    and "A = [a, 0, f]\<^sub>\<circ>"
+    and "B = [a', 0, f']\<^sub>\<circ>"
+    and "F = [g, 0]\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
-  shows "F : abf \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a'b'f'"
+  shows "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
 proof(intro is_arrI)
-  from assms(1,6,7,8) show "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  from assms(1,6,7,8) show "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
-  with assms(2) show "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>F\<rparr> = abf" "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>F\<rparr> = a'b'f'"
+  with assms(2) show "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
     by (cs_concl cs_simp: cat_comma_cs_simps)+
 qed
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_is_arrI
 
 lemma (in is_functor) cat_obj_cf_comma_is_arrI[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-    and "F = [baf, b'a'f', gh]\<^sub>\<circ>"
-    and "baf = [0, a, f]\<^sub>\<circ>"
-    and "b'a'f' = [0, a', f']\<^sub>\<circ>"
-    and "gh = [0, g]\<^sub>\<circ>"
+    and "ABF = [A, B, F]\<^sub>\<circ>"
+    and "A = [0, a, f]\<^sub>\<circ>"
+    and "B = [0, a', f']\<^sub>\<circ>"
+    and "F = [0, g]\<^sub>\<circ>"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
     and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
-  shows "F : baf \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b'a'f'"
+  shows "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
 proof(intro is_arrI)
-  from assms(1,6,7,8) show "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  from assms(1,6,7,8) show "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
-  with assms(2) show "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>F\<rparr> = baf" "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>F\<rparr> = b'a'f'"
+  with assms(2) show "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Dom\<rparr>\<lparr>ABF\<rparr> = A" "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Cod\<rparr>\<lparr>ABF\<rparr> = B"
     by (cs_concl cs_simp: cat_comma_cs_simps)+
 qed
 
 lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_is_arrI
 
 lemma (in is_functor) cat_cf_obj_comma_is_arrD[dest]:
   assumes "[[a, b', f]\<^sub>\<circ>, [a', b'', f']\<^sub>\<circ>, [g, h]\<^sub>\<circ>]\<^sub>\<circ> :
     [a, b', f]\<^sub>\<circ> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> [a', b'', f']\<^sub>\<circ>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-  shows "b' = []\<^sub>\<circ>"
-    and "b'' = []\<^sub>\<circ>"
-    and "h = []\<^sub>\<circ>"
+  shows "b' = 0"
+    and "b'' = 0"
+    and "h = 0"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
     and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
     and "[a', b'', f']\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   by (intro cat_cf_obj_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+
 
 lemma (in is_functor) cat_obj_cf_comma_is_arrD[dest]:
   assumes "[[b', a, f]\<^sub>\<circ>, [b'', a', f']\<^sub>\<circ>, [h, g]\<^sub>\<circ>]\<^sub>\<circ> :
     [b', a, f]\<^sub>\<circ> \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [b'', a', f']\<^sub>\<circ>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "b' = 0"
     and "b'' = 0"
     and "h = 0"
     and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
     and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
     and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
     and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     and "[b'', a', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   by (intro cat_obj_cf_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+
 
 lemmas [dest] = is_functor.cat_obj_cf_comma_is_arrD
 
 lemma (in is_functor) cat_cf_obj_comma_is_arrE[elim]:
-  assumes "F : abf \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a'b'f'" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  assumes "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   obtains a f a' f' g 
-    where "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "abf = [a, 0, f]\<^sub>\<circ>"
-      and "a'b'f' = [a', 0, f']\<^sub>\<circ>"
+    where "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [a, 0, f]\<^sub>\<circ>"
+      and "B = [a', 0, f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
-      and "abf \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
-      and "a'b'f' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+      and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+      and "B \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
 proof-
-  note F = is_arrD[OF assms(1)]
-  from F(1) obtain abf' a'b'f'' a f a' f' g 
-    where F_def: "F = [abf', a'b'f'', [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
-      and abf'_def: "abf' = [a, 0, f]\<^sub>\<circ>"
-      and a'b'f''_def: "a'b'f'' = [a', 0, f']\<^sub>\<circ>"
+  note ABF = is_arrD[OF assms(1)]
+  from ABF(1) obtain C D a f a' f' g 
+    where ABF_def: "ABF = [C, D, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+      and C_def: "C = [a, 0, f]\<^sub>\<circ>"
+      and D_def: "D = [a', 0, f']\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
       and f_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f" 
-      and abf': "abf' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" 
-      and a'b'f'': "a'b'f'' \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+      and C: "C \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>" 
+      and D: "D \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
     by (elim cat_cf_obj_comma_ArrE[OF _ assms(2)])
-  from F(2) assms(2) abf'_def a'b'f''_def g f f' f_def have "abf' = abf"
-    unfolding F_def 
+  from ABF(2) assms(2) C_def D_def g f f' f_def have [simp]: "C = A"
+    unfolding ABF_def 
     by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
-  from F(3) assms(2) abf'_def a'b'f''_def g f f' f_def have "a'b'f'' = a'b'f'"
-    unfolding F_def 
+  from ABF(3) assms(2) C_def D_def g f f' f_def have [simp]: "D = B"
+    unfolding ABF_def 
     by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
-  from that F_def abf'_def a'b'f''_def g f f' f_def abf' a'b'f'' show ?thesis
-    unfolding \<open>abf' = abf\<close> \<open>a'b'f'' = a'b'f'\<close> by auto
+  from that ABF_def C_def D_def g f f' f_def C D show ?thesis by auto
 qed
 
 lemmas [elim] = is_functor.cat_cf_obj_comma_is_arrE
 
 lemma (in is_functor) cat_obj_cf_comma_is_arrE[elim]:
-  assumes "F : baf \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b'a'f'"
-    and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  assumes "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   obtains a f a' f' g
-    where "F = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
-      and "baf = [0, a, f]\<^sub>\<circ>"
-      and "b'a'f' = [0, a', f']\<^sub>\<circ>"
+    where "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+      and "A = [0, a, f]\<^sub>\<circ>"
+      and "B = [0, a', f']\<^sub>\<circ>"
       and "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       and "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
-      and "baf \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      and "b'a'f' \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and "B \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof-
-  note F = is_arrD[OF assms(1)]
-  from F(1) obtain baf' b'a'f'' a f a' f' g 
-    where F_def: "F = [baf', b'a'f'', [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
-      and baf'_def: "baf' = [0, a, f]\<^sub>\<circ>"
-      and b'a'f''_def: "b'a'f'' = [0, a', f']\<^sub>\<circ>"
+  note ABF = is_arrD[OF assms(1)]
+  from ABF(1) obtain C D a f a' f' g 
+    where ABF_def: "ABF = [C, D, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+      and C_def: "C = [0, a, f]\<^sub>\<circ>"
+      and D_def: "D = [0, a', f']\<^sub>\<circ>"
       and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
       and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'" 
-      and baf': "baf' \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" 
-      and b'a'f'': "b'a'f'' \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+      and C: "C \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" 
+      and D: "D \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by (elim cat_obj_cf_comma_ArrE[OF _ assms(2)])
-  from F(2) assms(2) baf'_def b'a'f''_def g f f' f'_def have "baf' = baf"
-    unfolding F_def 
+  from ABF(2) assms(2) C_def D_def g f f' f'_def have [simp]: "C = A"
+    unfolding ABF_def 
     by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
-  from F(3) assms(2) baf'_def b'a'f''_def g f f' f'_def have "b'a'f'' = b'a'f'"
-    unfolding F_def 
+  from ABF(3) assms(2) C_def D_def g f f' f'_def have [simp]: "D = B"
+    unfolding ABF_def 
     by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
-  from that F_def baf'_def b'a'f''_def g f f' f'_def baf' b'a'f'' show ?thesis
-    unfolding \<open>baf' = baf\<close> \<open>b'a'f'' = b'a'f'\<close> by auto
+  from that ABF_def C_def D_def g f f' f'_def C D show ?thesis by auto
 qed
 
 lemmas [elim] = is_functor.cat_obj_cf_comma_is_arrE
 
 
 subsubsection\<open>Composition\<close>
 
 lemma cat_cf_obj_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Comp\<rparr>)"
   unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma cat_obj_cf_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Comp\<rparr>)"
   unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma (in is_functor) cat_cf_obj_comma_Comp_app[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
-    and "G = [a'b'f', a''b''f'', [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
-    and "F = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "G : a'b'f' \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a''b''f''" 
-    and "F : abf \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a'b'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> F = [abf, a''b''f'', [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "BCG = [B, C, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
+    and "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "BCG : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C" 
+    and "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
+  shows "BCG \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> ABF = [A, C, [g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from assms(4) obtain a f a' f' g
-    where G_def: "G = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+    where BCG_def: "BCG = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
     by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
   from assms(5) obtain a f a' f' g
-    where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+    where ABF_def: "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>"
     by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
-  from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
+  from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
     "h' = 0" "h = 0"
     by simp_all
   have "h' \<circ>\<^sub>A\<^bsub>cat_1 0 0\<^esub> h = 0" by (cs_concl cs_simp: cat_cs_simps)
   show ?thesis
     by 
       (
         rule cat_comma_Comp_app
           [
             OF 
               is_functor_axioms 
               const 
               assms(2,3) 
               assms(4)[unfolded cat_cf_obj_comma_def] 
               assms(5)[unfolded cat_cf_obj_comma_def],
             folded cat_cf_obj_comma_def,
             unfolded cat_cs_simps
           ]
       )
 qed
 
 lemma (in is_functor) cat_obj_cf_comma_Comp_app[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
-    and "G = [b'a'f', b''a''f'', [h', g']\<^sub>\<circ>]\<^sub>\<circ>"
-    and "F = [baf, b'a'f', [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
-    and "G : b'a'f' \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b''a''f''" 
-    and "F : baf \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b'a'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> F = [baf, b''a''f'', [0, g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "BCG = [B, C, [h', g']\<^sub>\<circ>]\<^sub>\<circ>"
+    and "ABF = [A, B, [h, g]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "BCG : B \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C" 
+    and "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
+  shows "BCG \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> ABF = [A, C, [0, g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_simp: cs_intro: vempty_is_zet cat_cs_intros)
   from assms(4) obtain a f a' f' g
-    where G_def: "G = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+    where BCG_def: "BCG = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
     by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
   from assms(5) obtain a f a' f' g
-    where F_def: "F = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+    where ABF_def: "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
     by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
-  from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
+  from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
     "h' = 0" "h = 0"
     by simp_all
   have "h' \<circ>\<^sub>A\<^bsub>cat_1 0 0\<^esub> h = 0" by (cs_concl cs_simp: cat_cs_simps) show ?thesis
     by 
       (
         rule cat_comma_Comp_app
           [
             OF 
               const 
               is_functor_axioms
               assms(2,3) 
               assms(4)[unfolded cat_obj_cf_comma_def] 
               assms(5)[unfolded cat_obj_cf_comma_def],
             folded cat_obj_cf_comma_def,
             unfolded cat_cs_simps
           ]
       )
 qed
 
 lemma (in is_functor) cat_cf_obj_comma_Comp_is_arr[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
-    and "G : a'b'f' \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a''b''f''" 
-    and "F : abf \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a'b'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> F : abf \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> a''b''f''"
+    and "BCG : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C" 
+    and "ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B"
+  shows "BCG \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> ABF : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> C"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Comp_is_arr
           [
             OF 
               is_functor_axioms 
               const 
               assms(2)[unfolded cat_cf_obj_comma_def]
               assms(3)[unfolded cat_cf_obj_comma_def],
             folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma (in is_functor) cat_obj_cf_comma_Comp_is_arr[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
-    and "G : b'a'f' \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b''a''f''" 
-    and "F : baf \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b'a'f'"
-  shows "G \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> F : baf \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> b''a''f''"
+    and "BCG : B \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C" 
+    and "ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
+  shows "BCG \<circ>\<^sub>A\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> ABF : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_Comp_is_arr
           [
             OF 
               const 
               is_functor_axioms 
               assms(2)[unfolded cat_obj_cf_comma_def]
               assms(3)[unfolded cat_obj_cf_comma_def],
             folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_cf_obj_comma_CId_vsv[cat_comma_cs_intros]: "vsv (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>)"
   unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma cat_obj_cf_comma_CId_vsv[cat_comma_cs_intros]: "vsv (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>)"
   unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma (in is_functor) cat_cf_obj_comma_CId_vdomain[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule cat_comma_CId_vdomain[
           OF is_functor_axioms const, folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma (in is_functor) cat_obj_cf_comma_CId_vdomain[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show "\<D>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by 
       (
         rule cat_comma_CId_vdomain[
           OF const is_functor_axioms, folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 lemma (in is_functor) cat_cf_obj_comma_CId_app[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A = [a, b', f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   shows "\<FF> \<^sub>C\<^sub>F\<down> b\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, 0]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from assms(3,2) have b'_def: "b' = 0"
     by (auto elim: cat_cf_obj_comma_ObjE[OF _ assms(1)])
   have [cat_cs_simps]: "cat_1 0 0\<lparr>CId\<rparr>\<lparr>b'\<rparr> = 0" 
     unfolding cat_1_components b'_def by simp
   show ?thesis
     by 
       ( 
         rule cat_comma_CId_app
           [
             OF 
               is_functor_axioms 
               const
               assms(2,3)[unfolded cat_cf_obj_comma_def],  
             unfolded cat_cf_obj_comma_def[symmetric] cat_cs_simps
           ]
         )
 qed
 
 lemma (in is_functor) cat_obj_cf_comma_CId_app[cat_comma_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A = [b', a, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   shows "b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>A\<rparr> = [A, A, [0, \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   from assms(3,2) have b'_def: "b' = 0"
     by (auto elim: cat_obj_cf_comma_ObjE[OF _ assms(1)])
   have [cat_cs_simps]: "cat_1 0 0\<lparr>CId\<rparr>\<lparr>b'\<rparr> = 0" 
     unfolding cat_1_components b'_def by simp
   show ?thesis
     by 
       ( 
         rule cat_comma_CId_app
           [
             OF 
               const
               is_functor_axioms 
               assms(2,3)[unfolded cat_obj_cf_comma_def],  
             unfolded cat_obj_cf_comma_def[symmetric] cat_cs_simps
           ]
         )
 qed
 
 
 subsubsection\<open>
 Comma categories constructed from a functor and an object are categories
 \<close>
 
 lemma (in is_functor) category_cat_cf_obj_comma[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> b)"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule category_cat_comma[
           OF is_functor_axioms const, folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemmas [cat_comma_cs_intros] = is_functor.category_cat_cf_obj_comma
 
 lemma (in is_functor) category_cat_obj_cf_comma[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "category \<alpha> (b \<down>\<^sub>C\<^sub>F \<FF>)"
 proof-
   from assms(1) have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
   show ?thesis
     by 
       (
         rule category_cat_comma[
           OF const is_functor_axioms, folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 lemmas [cat_comma_cs_intros] = is_functor.category_cat_obj_cf_comma
 
 
 subsubsection\<open>Tiny comma categories constructed from a functor and an object\<close>
 
 lemma (in is_tm_functor) tiny_category_cat_cf_obj_comma[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "tiny_category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> b)"
 proof-
   from assms(1) have const: 
     "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
     by 
       (
         cs_concl cs_intro: 
           vempty_is_zet cat_small_cs_intros cat_cs_intros
       )
   show ?thesis
     by 
       (
         rule tiny_category_cat_comma[
           OF is_tm_functor_axioms const, folded cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma (in is_tm_functor) tiny_category_cat_obj_cf_comma[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "tiny_category \<alpha> (b \<down>\<^sub>C\<^sub>F \<FF>)"
 proof-
   from assms(1) have const: 
     "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
     by 
       (
         cs_concl cs_intro: 
           vempty_is_zet cat_small_cs_intros cat_cs_intros
       )
   show ?thesis
     by 
       (
         rule tiny_category_cat_comma[
           OF const is_tm_functor_axioms, folded cat_obj_cf_comma_def
           ]
       )
 qed
 
 
 
 subsection\<open>
+Opposite comma category functors for the comma categories
+constructed from a functor and an object
+\<close>
+
+
+subsubsection\<open>Definitions and elementary properties\<close>
+
+definition op_cf_obj_comma :: "V \<Rightarrow> V \<Rightarrow> V"
+  where "op_cf_obj_comma \<FF> b =
+    op_cf_comma \<FF> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"
+
+definition op_obj_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V"
+  where "op_obj_cf_comma b \<FF> =
+    op_cf_comma (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<FF>"
+
+
+text\<open>Alternative forms of the definitions.\<close>
+
+lemma (in is_functor) op_cf_obj_comma_def: 
+  "op_cf_obj_comma \<FF> b = op_cf_comma \<FF> (cf_const (cat_1 0 0) \<BB> b)"
+  unfolding op_cf_obj_comma_def cat_cs_simps by simp
+
+lemma (in is_functor) op_obj_cf_comma_def:
+  "op_obj_cf_comma b \<FF> = op_cf_comma (cf_const (cat_1 0 0) \<BB> b) \<FF>"
+  unfolding op_obj_cf_comma_def cat_cs_simps by simp
+
+
+subsubsection\<open>Object map\<close>
+
+lemma op_cf_obj_comma_ObjMap_vsv[cat_comma_cs_intros]:
+  "vsv (op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>)"
+  unfolding op_cf_obj_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
+
+lemma op_obj_cf_comma_ObjMap_vsv[cat_comma_cs_intros]:
+  "vsv (op_obj_cf_comma b \<FF>\<lparr>ObjMap\<rparr>)"
+  unfolding op_obj_cf_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
+
+lemma (in is_functor) op_cf_obj_comma_ObjMap_vdomain[cat_comma_cs_simps]:
+  "\<D>\<^sub>\<circ> (op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+  unfolding op_cf_obj_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric])
+
+lemma (in is_functor) op_obj_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]:
+  "\<D>\<^sub>\<circ> (op_obj_cf_comma b \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  unfolding op_obj_cf_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric])
+
+lemma (in is_functor) op_cf_obj_comma_ObjMap_app[cat_comma_cs_simps]:
+  assumes "A = [a, 0, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+  shows "op_cf_obj_comma \<FF> b\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [0, a, f]\<^sub>\<circ>"
+proof-
+  have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+    by (intro cat_cf_obj_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
+  from assms(2) a f show ?thesis
+    using assms(2)
+    unfolding assms(1) op_cf_obj_comma_def
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_comma_cs_simps
+          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
+      )
+qed
+
+lemma (in is_functor) op_obj_cf_comma_ObjMap_app[cat_comma_cs_simps]:
+  assumes "A = [0, a, f]\<^sub>\<circ>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  shows "op_obj_cf_comma b \<FF> \<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a, 0, f]\<^sub>\<circ>"
+proof-
+  have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+    by (intro cat_obj_cf_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
+  from assms(2) a f show ?thesis
+    using assms(2)
+    unfolding assms(1) op_obj_cf_comma_def
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_comma_cs_simps
+          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
+      )
+qed
+
+
+subsubsection\<open>Arrow map\<close>
+
+lemma op_cf_obj_comma_ArrMap_vsv[cat_comma_cs_intros]:
+  "vsv (op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>)"
+  unfolding op_cf_obj_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
+
+lemma op_obj_cf_comma_ArrMap_vsv[cat_comma_cs_intros]:
+  "vsv (op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>)"
+  unfolding op_obj_cf_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
+
+lemma (in is_functor) op_cf_obj_comma_ArrMap_vdomain[cat_comma_cs_simps]:
+  "\<D>\<^sub>\<circ> (op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  unfolding op_cf_obj_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric])
+
+lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_vdomain
+
+lemma (in is_functor) op_obj_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]:
+  "\<D>\<^sub>\<circ> (op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  unfolding op_obj_cf_comma_def
+  by (cs_concl cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric])
+
+lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_vdomain
+
+lemma (in is_functor) op_cf_obj_comma_ArrMap_app[cat_comma_cs_simps]:
+  assumes "ABF = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [g, 0]\<^sub>\<circ>]\<^sub>\<circ>" 
+    and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
+    and "ABF \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  shows "op_cf_obj_comma \<FF> b\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = [[0, a', f']\<^sub>\<circ>, [0, a, f]\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
+proof-
+  from assms(3) have g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+    and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+    and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+    and [cat_comma_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = f"
+    by (intro cat_cf_obj_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
+  from assms(2) g f f' show ?thesis
+    unfolding assms(1) op_cf_obj_comma_def
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
+          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
+      )
+qed
+
+lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_app
+
+lemma (in is_functor) op_obj_cf_comma_ArrMap_app[cat_comma_cs_simps]:
+  assumes "ABF = [[0, a, f]\<^sub>\<circ>, [0, a', f']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>" 
+    and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
+    and "ABF \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  shows "op_obj_cf_comma b \<FF>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = [[a', 0, f']\<^sub>\<circ>, [a, 0, f]\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+proof-
+  from assms(3) have h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+    and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+    and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
+    and [cat_comma_cs_simps]: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
+    by (intro cat_obj_cf_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
+  from assms(2) h f f' show ?thesis
+    unfolding assms(1) op_obj_cf_comma_def
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
+          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
+      )
+qed
+
+lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_app
+
+
+subsubsection\<open>
+Opposite comma category functors for the comma categories
+constructed from a functor and an object are isomorphisms of categories
+\<close>
+
+lemma (in is_functor) op_cf_obj_comma_is_iso_functor:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_cf_obj_comma \<FF> b : op_cat (\<FF> \<^sub>C\<^sub>F\<down> b) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+proof-
+  from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
+  note cat_obj_cf_comma_def = 
+    is_functor.cat_obj_cf_comma_def[
+      OF is_functor_op, unfolded cat_op_simps
+      ]
+  show ?thesis
+    by 
+      (
+        rule op_cf_comma_is_iso_functor
+          [
+            OF is_functor_axioms cf_const, 
+            folded cat_cf_obj_comma_def op_cf_obj_comma_def,
+            unfolded cat_op_simps, 
+            folded cat_obj_cf_comma_def
+          ]
+      )
+qed
+
+lemma (in is_functor) op_cf_obj_comma_is_iso_functor'[cat_comma_cs_intros]:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+    and "\<AA>' = op_cat (\<FF> \<^sub>C\<^sub>F\<down> b)"
+    and "\<BB>' = b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+  shows "op_cf_obj_comma \<FF> b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_iso_functor)
+
+lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_iso_functor'
+
+lemma (in is_functor) op_cf_obj_comma_is_functor:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_cf_obj_comma \<FF> b : op_cat (\<FF> \<^sub>C\<^sub>F\<down> b) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+  by (rule is_iso_functorD(1)[OF op_cf_obj_comma_is_iso_functor[OF assms]])
+
+lemma (in is_functor) op_cf_obj_comma_is_functor'[cat_comma_cs_intros]:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+    and "\<AA>' = op_cat (\<FF> \<^sub>C\<^sub>F\<down> b)"
+    and "\<BB>' = b \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+  shows "op_cf_obj_comma \<FF> b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_functor)
+
+lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_functor'
+
+lemma (in is_functor) op_obj_cf_comma_is_iso_functor:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_obj_cf_comma b \<FF> : op_cat (b \<down>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
+proof-
+  from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
+  note cat_cf_obj_comma_def = 
+    is_functor.cat_cf_obj_comma_def[
+      OF is_functor_op, unfolded cat_op_simps
+      ]
+  show ?thesis
+    by
+      (
+        rule op_cf_comma_is_iso_functor
+          [
+            OF cf_const is_functor_axioms,
+            folded cat_obj_cf_comma_def op_obj_cf_comma_def,
+            unfolded cat_op_simps,
+            folded cat_cf_obj_comma_def
+          ]
+      )
+qed
+
+lemma (in is_functor) op_obj_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+    and "\<AA>' = op_cat (b \<down>\<^sub>C\<^sub>F \<FF>)"
+    and "\<BB>' = (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
+  shows "op_obj_cf_comma b \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_iso_functor)
+  
+lemmas [cat_comma_cs_intros] = is_functor.op_obj_cf_comma_is_iso_functor'
+
+lemma (in is_functor) op_obj_cf_comma_is_functor:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_obj_cf_comma b \<FF> : op_cat (b \<down>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
+  by (rule is_iso_functorD(1)[OF op_obj_cf_comma_is_iso_functor[OF assms]])
+
+lemma (in is_functor) op_obj_cf_comma_is_functor'[cat_comma_cs_intros]:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+    and "\<AA>' = op_cat (b \<down>\<^sub>C\<^sub>F \<FF>)"
+    and "\<BB>' = (op_cf \<FF>) \<^sub>C\<^sub>F\<down> b"
+  shows "op_obj_cf_comma b \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_functor)
+
+
+
+subsection\<open>
 Projections for comma categories constructed from a functor and an object
 \<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 definition cf_cf_obj_comma_proj :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>C\<^sub>F\<Sqinter>\<^sub>O _)\<close> [1000, 1000] 999)
   where "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<equiv> \<FF> \<^sub>C\<^sub>F\<Sqinter> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b)"
 
 definition cf_obj_cf_comma_proj :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>(_ \<^sub>O\<Sqinter>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
   where "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<equiv> (cf_const (cat_1 0 0) (\<FF>\<lparr>HomCod\<rparr>) b) \<Sqinter>\<^sub>C\<^sub>F \<FF>"
 
 
 text\<open>Alternative forms of the definitions.\<close>
 
 lemma (in is_functor) cf_cf_obj_comma_proj_def:
   "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b = \<FF> \<^sub>C\<^sub>F\<Sqinter> (cf_const (cat_1 0 0) \<BB> b)" 
   unfolding cf_cf_obj_comma_proj_def cf_HomCod..
 
 lemma (in is_functor) cf_obj_cf_comma_proj_def: 
   "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> = (cf_const (cat_1 0 0) \<BB> b) \<Sqinter>\<^sub>C\<^sub>F \<FF>" 
   unfolding cf_obj_cf_comma_proj_def cf_HomCod..
 
 
 text\<open>Components.\<close>
 
 lemma (in is_functor) cf_cf_obj_comma_proj_components[cat_comma_cs_simps]: 
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> b"
     and "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>HomCod\<rparr> = \<AA>"
   unfolding 
     cf_cf_obj_comma_proj_def 
     cf_comma_proj_left_components 
     cat_cf_obj_comma_def[symmetric]
     cat_cs_simps 
   by simp_all
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_components
 
 lemma (in is_functor) cf_obj_cf_comma_proj_components[cat_comma_cs_simps]: 
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = b \<down>\<^sub>C\<^sub>F \<FF>"
     and "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = \<AA>"
   unfolding 
     cf_obj_cf_comma_proj_def 
     cf_comma_proj_right_components 
     cat_obj_cf_comma_def[symmetric]
     cat_cs_simps 
   by simp_all
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_components
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_cf_obj_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
   "vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>)"
   unfolding cf_cf_obj_comma_proj_def
   by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma cf_obj_cf_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
   "vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding cf_obj_cf_comma_proj_def
   by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
   "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ObjMap_vdomain
   unfolding 
     cf_cf_obj_comma_proj_def[symmetric] 
     cf_comma_proj_left_components[symmetric]
     cat_comma_cs_simps
   by simp
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain
 
 lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
   "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ObjMap_vdomain
   unfolding 
     cf_obj_cf_comma_proj_def[symmetric] 
     cf_comma_proj_right_components[symmetric]
     cat_comma_cs_simps
   by simp
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_vdomain
 
 lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_app[cat_comma_cs_simps]:
   assumes "A = [a, b', f]\<^sub>\<circ>" and "[a, b', f]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
   by 
     (
       rule cf_comma_proj_left_ObjMap_app[
         OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
         folded cf_cf_obj_comma_proj_def
         ]
     )
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_app
 
 lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_app[cat_comma_cs_simps]:
   assumes "A = [b', a, f]\<^sub>\<circ>" and "[b', a, f]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a"
   by 
     (
       rule cf_comma_proj_right_ObjMap_app[
         OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
         folded cf_obj_cf_comma_proj_def
         ]
     )
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_cf_obj_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
   "vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>)"
   unfolding cf_cf_obj_comma_proj_def
   by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma cf_obj_cf_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
   "vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding cf_obj_cf_comma_proj_def
   by (cs_concl cs_intro: cat_comma_cs_intros)
 
 lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]: 
   "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
   unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ArrMap_vdomain
   unfolding 
     cf_cf_obj_comma_proj_def[symmetric] 
     cf_comma_proj_left_components[symmetric]
     cat_comma_cs_simps
   by simp
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain
 
 lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
   "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
   unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ArrMap_vdomain
   unfolding 
     cf_obj_cf_comma_proj_def[symmetric] 
     cf_comma_proj_right_components[symmetric]
     cat_comma_cs_simps
   by simp
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_vdomain
 
 lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_app[cat_comma_cs_simps]:
-  assumes "A = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
-    and "[abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
-  shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> = g"
+  assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
+    and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+  shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = g"
   by 
     (
       rule cf_comma_proj_left_ArrMap_app[
         OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
         folded cf_cf_obj_comma_proj_def
         ]
     )
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ArrMap_app
 
 lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_app[cat_comma_cs_simps]:
-  assumes "A = [abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
-    and "[abf, a'b'f', [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-  shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> = h"
+  assumes "ABF = [A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ>" 
+    and "[A, B, [g, h]\<^sub>\<circ>]\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>ABF\<rparr> = h"
   by 
     (
       rule cf_comma_proj_right_ArrMap_app[
         OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
         folded cf_obj_cf_comma_proj_def
         ]
     )
 
 lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_app
 
 
 subsubsection\<open>Projections for a comma category are functors\<close>
 
 lemma (in is_functor) cf_cf_obj_comma_proj_is_functor:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
   show ?thesis
     by 
       (
         rule cf_comma_proj_left_is_functor[
           OF is_functor_axioms const,
           folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma (in is_functor) cf_cf_obj_comma_proj_is_functor'[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = \<FF> \<^sub>C\<^sub>F\<down> b"
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_functor)
 
 lemmas [cat_comma_cs_intros] = is_functor.cf_cf_obj_comma_proj_is_functor'
 
 lemma (in is_functor) cf_obj_cf_comma_proj_is_functor:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
   show ?thesis
     by 
       (
         rule cf_comma_proj_right_is_functor[
           OF const is_functor_axioms,
           folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
           ]
       )
 qed
 
 lemma (in is_functor) cf_obj_cf_comma_proj_is_functor'[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = b \<down>\<^sub>C\<^sub>F \<FF>"
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_functor)
 
 lemmas [cat_comma_cs_intros] = is_functor.cf_obj_cf_comma_proj_is_functor'
 
 
+subsubsection\<open>
+Opposite projections for comma categories constructed from a functor 
+and an object
+\<close>
+
+lemma (in is_functor) op_cf_cf_obj_comma_proj: 
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_cf (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b) = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> b"
+proof-
+  from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
+  show ?thesis
+    by
+      (
+        rule op_cf_comma_proj_left
+          [
+            OF is_functor_axioms cf_const,
+            unfolded cat_op_simps,
+            folded 
+              cf_cf_obj_comma_proj_def
+              op_cf_obj_comma_def
+              is_functor.cf_obj_cf_comma_proj_def[
+                OF is_functor_op, unfolded cat_op_simps
+                ]
+          ]
+      )
+qed
+
+lemma (in is_functor) op_cf_obj_cf_comma_proj:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "op_cf (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>) = (op_cf \<FF>) \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F op_obj_cf_comma b \<FF>"
+proof-
+  from assms have cf_const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
+  show ?thesis
+    by 
+      (
+        rule op_cf_comma_proj_right
+          [
+            OF cf_const is_functor_axioms,
+            unfolded cat_op_simps,
+            folded
+              cf_obj_cf_comma_proj_def
+              op_obj_cf_comma_def
+              is_functor.cf_cf_obj_comma_proj_def[
+                OF is_functor_op, unfolded cat_op_simps
+                ]
+          ]
+      )
+qed
+
+
 subsubsection\<open>Projections for a tiny comma category\<close>
 
 lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
   show ?thesis
     by 
       (
         rule cf_comma_proj_left_is_tm_functor[
           OF is_tm_functor_axioms const,
           folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
           ]
       )
 qed
 
 lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<FF>b = \<FF> \<^sub>C\<^sub>F\<down> b"
   shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b : \<FF>b \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_tm_functor)
 
 lemmas [cat_comma_cs_intros] = is_tm_functor.cf_cf_obj_comma_proj_is_tm_functor'
 
 lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   from assms have const: "cf_const (cat_1 0 0) \<BB> b : cat_1 0 0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
   show ?thesis
     by 
       (
         rule cf_comma_proj_right_is_tm_functor[
           OF const is_tm_functor_axioms,
           folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
           ]
       )
 qed
 
 lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = b \<down>\<^sub>C\<^sub>F \<FF>"
   shows "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<AA>"
   using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_tm_functor)
 
 lemmas [cat_comma_cs_intros] = is_tm_functor.cf_obj_cf_comma_proj_is_tm_functor'
 
 
 
 subsection\<open>Comma functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.\<close>
 
-definition cf_cf_arr_comma :: "V \<Rightarrow> V \<Rightarrow> V" 
+definition cf_arr_cf_comma :: "V \<Rightarrow> V \<Rightarrow> V" 
   (\<open>(_ \<^sub>A\<down>\<^sub>C\<^sub>F _)\<close> [1000, 1000] 999)
   where "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> =
     [
       (\<lambda>A\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>),
       (
         \<lambda>F\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
           [
             [0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
             [0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
             F\<lparr>2\<^sub>\<nat>\<rparr>
           ]\<^sub>\<circ>
       ),
       (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>,
       (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>
     ]\<^sub>\<circ>"
 
+definition cf_cf_arr_comma :: "V \<Rightarrow> V \<Rightarrow> V" 
+  (\<open>(_ \<^sub>C\<^sub>F\<down>\<^sub>A _)\<close> [1000, 1000] 999)
+  where "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g =
+    [
+      (\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
+      (
+        \<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Arr\<rparr>.
+          [
+            [F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            [F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            F\<lparr>2\<^sub>\<nat>\<rparr>
+          ]\<^sub>\<circ>
+      ),
+      \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>),
+      \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)
+    ]\<^sub>\<circ>"
+
 
 text\<open>Components.\<close>
 
-lemma cf_cf_arr_comma_components:
+lemma cf_arr_cf_comma_components:
   shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> =
     (\<lambda>A\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>)"
     and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> =
       (
         \<lambda>F\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
           [
             [0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
             [0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> g]\<^sub>\<circ>,
             F\<lparr>2\<^sub>\<nat>\<rparr>
           ]\<^sub>\<circ>
       )"
     and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>"
     and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<FF>"
+  unfolding cf_arr_cf_comma_def dghm_field_simps 
+  by (simp_all add: nat_omega_simps)
+
+lemma cf_cf_arr_comma_components:
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr> =
+    (\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
+    and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr> =
+      (
+        \<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>Arr\<rparr>.
+          [
+            [F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            [F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<FF>\<lparr>HomCod\<rparr>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            F\<lparr>2\<^sub>\<nat>\<rparr>
+          ]\<^sub>\<circ>
+      )"
+    and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)"
+    and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomCod\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> (\<FF>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)"
   unfolding cf_cf_arr_comma_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 context is_functor
 begin
 
-lemma cf_cf_arr_comma_components':
+lemma cf_arr_cf_comma_components':
   assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
   shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>. [0, A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>)"
     and "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> =
       (
         \<lambda>F\<in>\<^sub>\<circ>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>.
           [
             [0, F\<lparr>0\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>,
             [0, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>,
             F\<lparr>2\<^sub>\<nat>\<rparr>
           ]\<^sub>\<circ>
       )"
     and [cat_comma_cs_simps]: "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomDom\<rparr> = c' \<down>\<^sub>C\<^sub>F \<FF>"
     and [cat_comma_cs_simps]: "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>HomCod\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>"
   using assms
+  unfolding cf_arr_cf_comma_components
+  by (simp_all add: cat_cs_simps)
+
+lemma cf_cf_arr_comma_components':
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
+    and "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr> =
+      (
+        \<lambda>F\<in>\<^sub>\<circ>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Arr\<rparr>.
+          [
+            [F\<lparr>0\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> F\<lparr>0\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            [F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>0\<rparr>, 0, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> F\<lparr>1\<^sub>\<nat>\<rparr>\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>,
+            F\<lparr>2\<^sub>\<nat>\<rparr>
+          ]\<^sub>\<circ>
+      )"
+    and [cat_comma_cs_simps]: "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomDom\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c"
+    and [cat_comma_cs_simps]: "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>HomCod\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c'"
+  using assms
   unfolding cf_cf_arr_comma_components
   by (simp_all add: cat_cs_simps)
 
 end
 
+lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_components'(3,4)
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_components'(3,4)
 
 
 subsubsection\<open>Object map\<close>
 
+mk_VLambda cf_arr_cf_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
+  |vsv cf_arr_cf_comma_ObjMap_vsv[cat_comma_cs_intros]|
+
 mk_VLambda cf_cf_arr_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
   |vsv cf_cf_arr_comma_ObjMap_vsv[cat_comma_cs_intros]|
 
 context is_functor
 begin
 
 context 
   fixes g c c'
   assumes g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
 begin
 
 mk_VLambda 
+  cf_arr_cf_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
+  |vdomain cf_arr_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]|
+
+mk_VLambda
   cf_cf_arr_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
   |vdomain cf_cf_arr_comma_ObjMap_vdomain[cat_comma_cs_simps]|
 
 end
 
 end
 
+lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_vdomain
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_vdomain
 
-lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
+lemma (in is_functor) cf_arr_cf_comma_ObjMap_app[cat_comma_cs_simps]:
   assumes "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
   shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a', b', f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>"
 proof-
   from assms have b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and f: "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
     and a'_def: "a' = 0"
     by auto
   from assms(2) show ?thesis
-    unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
+    unfolding cf_arr_cf_comma_components'[OF assms(3)] assms(1)
     by (simp add: nat_omega_simps a'_def)
 qed
 
-lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange: 
+lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
+  assumes "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>" and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a', b', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f']\<^sub>\<circ>"
+proof-
+  from assms have b'_def: "b' = 0"
+    and f: "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+    and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+    by auto
+  from assms(2) show ?thesis
+    unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
+    by (simp add: nat_omega_simps b'_def)
+qed
+
+lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_app
+lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_app
+
+lemma (in is_functor) cf_arr_cf_comma_ObjMap_vrange: 
   assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
   shows "\<R>\<^sub>\<circ> (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
 proof
   (
     rule vsv.vsv_vrange_vsubset, 
-    unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
+    unfold cf_arr_cf_comma_ObjMap_vdomain[OF assms]
   )
   fix A assume "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
   with assms is_functor_axioms obtain a f 
-    where A_def: "A = [[]\<^sub>\<circ>, a, f]\<^sub>\<circ>"
+    where A_def: "A = [0, a, f]\<^sub>\<circ>"
       and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
     by auto
   from assms a f show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
     by 
       (
         cs_concl
           cs_simp: cat_comma_cs_simps A_def
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
 qed (cs_concl cs_intro: cat_comma_cs_intros)
 
+lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange: 
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
+proof
+  (
+    rule vsv.vsv_vrange_vsubset, 
+    unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
+  )
+  fix A assume "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>"
+  with assms is_functor_axioms obtain a f 
+    where A_def: "A = [a, 0, f]\<^sub>\<circ>"
+      and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+      and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c" 
+    by auto
+  from assms a f show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
+    by
+      (
+        cs_concl
+          cs_simp: cat_comma_cs_simps A_def
+          cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+qed (cs_concl cs_intro: cat_comma_cs_intros)
+
 
 subsubsection\<open>Arrow map\<close>
 
+mk_VLambda cf_arr_cf_comma_components(2)
+  |vsv cf_arr_cf_comma_ArrMap_vsv[cat_comma_cs_intros]|
+
 mk_VLambda cf_cf_arr_comma_components(2)
   |vsv cf_cf_arr_comma_ArrMap_vsv[cat_comma_cs_intros]|
 
 context is_functor
 begin
 
 context 
   fixes g c c'
   assumes g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
 begin
 
 mk_VLambda 
+  cf_arr_cf_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
+  |vdomain cf_arr_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]|
+
+mk_VLambda 
   cf_cf_arr_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
   |vdomain cf_cf_arr_comma_ArrMap_vdomain[cat_comma_cs_simps]|
 
 end
 
 end
 
+lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_vdomain
 lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_vdomain
 
-lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
+lemma (in is_functor) cf_arr_cf_comma_ArrMap_app[cat_comma_cs_simps]:
   assumes "A = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
     and "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ> :
     [a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> [a', b', f']\<^sub>\<circ>" 
     and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
   shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> =
     [[a, b, f \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>, [a', b', f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g]\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
 proof-
   from assms(3) have c': "c' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
   from 
     cat_obj_cf_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c'] 
     is_arrD(1)[OF assms(2)] 
   show ?thesis
+    unfolding assms(1) cf_arr_cf_comma_components'[OF assms(3)]
+    by (simp_all add: nat_omega_simps)
+qed
+
+lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_app
+
+lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
+  assumes "A = [[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
+    and "[[a, b, f]\<^sub>\<circ>, [a', b', f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ> :
+      [a, b, f]\<^sub>\<circ> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> [a', b', f']\<^sub>\<circ>" 
+    and "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>A\<rparr> =
+    [[a, b, g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f]\<^sub>\<circ>, [a', b', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f']\<^sub>\<circ>, [h, k]\<^sub>\<circ>]\<^sub>\<circ>"
+proof-
+  from assms(3) have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
+  from 
+    cat_cf_obj_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c] 
+    is_arrD(1)[OF assms(2)] 
+  show ?thesis
     unfolding assms(1) cf_cf_arr_comma_components'[OF assms(3)]
     by (simp_all add: nat_omega_simps)
 qed
 
+lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_app
+
 
 subsubsection\<open>Comma functors are functors\<close>
 
+lemma (in is_functor) cf_arr_cf_comma_is_functor:
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : c' \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c \<down>\<^sub>C\<^sub>F \<FF>"
+proof(rule is_functorI')
+  show "vfsequence (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)" unfolding cf_arr_cf_comma_def by simp
+  from assms show "category \<alpha> (c' \<down>\<^sub>C\<^sub>F \<FF>)"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms show "category \<alpha> (c \<down>\<^sub>C\<^sub>F \<FF>)"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  show "vcard (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"
+    unfolding cf_arr_cf_comma_def by (simp_all add: nat_omega_simps)
+  from assms show "\<R>\<^sub>\<circ> (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by (intro cf_arr_cf_comma_ObjMap_vrange)
+  show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
+    g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
+    if "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for A B F
+  proof-
+    from assms that obtain b f b' f' k 
+      where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [0, b, f]\<^sub>\<circ>"
+        and B_def: "B = [0, b', f']\<^sub>\<circ>"
+        and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
+        and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+        and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+        and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
+      by auto
+    from assms that k f f' show ?thesis
+      unfolding F_def A_def B_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+  qed
+  show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> F\<rparr> =
+    g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+    if "G : B \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C" and "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for B C G A F
+  proof-
+    from that(2) assms obtain b f b' f' k 
+      where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [0, b, f]\<^sub>\<circ>"
+        and B_def: "B = [0, b', f']\<^sub>\<circ>"
+        and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
+        and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+        and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+        and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
+      by auto
+    with that(1) assms obtain b'' f'' k' 
+      where G_def: "G = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, k']\<^sub>\<circ>]\<^sub>\<circ>"
+        and C_def: "C = [0, b'', f'']\<^sub>\<circ>"
+        and k': "k' : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
+        and f'': "f'' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
+        and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
+      by auto (*slow*)
+    from assms that k f f' f'' k' show ?thesis
+      unfolding F_def G_def A_def B_def C_def 
+      by (*slow*)
+        (
+          cs_concl
+            cs_simp:
+              cat_cs_simps cat_comma_cs_simps
+              f''_def[symmetric] f'_def[symmetric]
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+  qed
+  show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
+    if "C \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" for C
+  proof-
+    from that assms obtain a f 
+      where C_def: "C = [0, a, f]\<^sub>\<circ>"
+        and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
+      by auto
+    from a assms f show
+      "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
+      unfolding C_def 
+      by
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+  qed
+qed
+  (
+    use assms in
+      \<open>
+        cs_concl
+          cs_simp: cat_comma_cs_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros
+      \<close>
+  )+
+
 lemma (in is_functor) cf_cf_arr_comma_is_functor:
   assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
-  shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : c' \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c \<down>\<^sub>C\<^sub>F \<FF>"
-proof-
-  show ?thesis
-  proof(rule is_functorI')
-    show "vfsequence (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)" unfolding cf_cf_arr_comma_def by simp
-    from assms show "category \<alpha> (c' \<down>\<^sub>C\<^sub>F \<FF>)"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    from assms show "category \<alpha> (c \<down>\<^sub>C\<^sub>F \<FF>)"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    show "vcard (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"
-      unfolding  cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
-    from assms show "\<R>\<^sub>\<circ> (g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      by (intro cf_cf_arr_comma_ObjMap_vrange)
-    show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
-      g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
-      if "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for A B F
-    proof-
-      from assms that obtain b f b' f' k 
-        where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
-          and A_def: "A = [0, b, f]\<^sub>\<circ>"
-          and B_def: "B = [0, b', f']\<^sub>\<circ>"
-          and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
-          and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
-          and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
-          and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
-        by auto
-      from assms that k f f' show ?thesis
-        unfolding F_def A_def B_def
-        by 
-          (
-            cs_concl
-              cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
-              cs_intro: cat_cs_intros cat_comma_cs_intros
-          )
-    qed
-    show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> F\<rparr> =
-      g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>c \<down>\<^sub>C\<^sub>F \<FF>\<^esub> g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
-      if "G : B \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> C" and "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" for B C G A F
-    proof-
-      from that(2) assms obtain b f b' f' k 
-        where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
-          and A_def: "A = [0, b, f]\<^sub>\<circ>"
-          and B_def: "B = [0, b', f']\<^sub>\<circ>"
-          and k: "k : b \<mapsto>\<^bsub>\<AA>\<^esub> b'"
-          and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
-          and f': "f' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
-          and f'_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f = f'"
-        by auto
-      with that(1) assms obtain b'' f'' k' 
-        where G_def: "G = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, k']\<^sub>\<circ>]\<^sub>\<circ>"
-          and C_def: "C = [0, b'', f'']\<^sub>\<circ>"
-          and k': "k' : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
-          and f'': "f'' : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
-          and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>k'\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
-        by auto (*slow*)
-      from assms that k f f' f'' k' show ?thesis
-        unfolding F_def G_def A_def B_def C_def 
-        by (*slow*)
-          (
-            cs_concl
-              cs_simp:
-                cat_cs_simps cat_comma_cs_simps
-                f''_def[symmetric] f'_def[symmetric]
-              cs_intro: cat_cs_intros cat_comma_cs_intros
-          )
-    qed
-    show "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
-      if "C \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>" for C
-    proof-
-      from that assms obtain a f 
-        where C_def: "C = [0, a, f]\<^sub>\<circ>"
-          and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-          and f: "f : c' \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
-        by auto
-      from a assms f show
-        "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>c' \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = c \<down>\<^sub>C\<^sub>F \<FF>\<lparr>CId\<rparr>\<lparr>g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
-        unfolding C_def 
-        by
-          (
-            cs_concl
-              cs_simp: cat_cs_simps cat_comma_cs_simps
-              cs_intro: cat_cs_intros cat_comma_cs_intros
-          )
-    qed
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g : \<FF> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> c'"
+proof(rule is_functorI')
+  from assms have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
+  show "vfsequence (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g)" unfolding cf_cf_arr_comma_def by simp
+  from assms show "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> c')"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms show "category \<alpha> (\<FF> \<^sub>C\<^sub>F\<down> c)"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  show "vcard (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) = 4\<^sub>\<nat>"
+    unfolding cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
+  from assms show "\<R>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>Obj\<rparr>"
+    by (intro cf_cf_arr_comma_ObjMap_vrange)
+  show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
+    \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c'\<^esub> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
+    if "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" for A B F
+  proof-
+    from assms that obtain a f a' f' h 
+      where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [a, 0, f]\<^sub>\<circ>"
+        and B_def: "B = [a', 0, f']\<^sub>\<circ>"
+        and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+        and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and f'_def: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
+      by auto
+    from assms that h f f' show ?thesis
+      unfolding F_def A_def B_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
   qed
-    (
-      use assms in
-        \<open>
+  show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> F\<rparr> =
+    \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c'\<^esub> \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+    if "G : B \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> C" and "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" for B C G A F
+  proof-
+    from that(2) assms obtain a f a' f' h 
+      where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [a, 0, f]\<^sub>\<circ>"
+        and B_def: "B = [a', 0, f']\<^sub>\<circ>"
+        and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+        and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and [cat_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
+      by auto
+    with that(1) assms obtain a'' f'' h' 
+      where G_def: "G = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [h', 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and C_def: "C = [a'', 0, f'']\<^sub>\<circ>"
+        and h': "h' : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
+        and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> = f'"
+      by auto (*slow*)
+    note [cat_cs_simps] = category.cat_assoc_helper[
+        where \<CC>=\<BB>, where h=f'' and g=\<open>\<FF>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr>\<close> and q=f'
+        ]
+    from assms that c h f f' f'' h' show ?thesis
+      unfolding F_def G_def A_def B_def C_def
+      by
+        (
           cs_concl
-            cs_simp: cat_comma_cs_simps
+             cs_simp: cat_cs_simps cat_comma_cs_simps
             cs_intro: cat_cs_intros cat_comma_cs_intros
-        \<close>
-    )+
+        )
+  qed
+  show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ArrMap\<rparr>\<lparr>\<FF> \<^sub>C\<^sub>F\<down> c\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> = \<FF> \<^sub>C\<^sub>F\<down> c'\<lparr>CId\<rparr>\<lparr>\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
+    if "C \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>" for C
+  proof-
+    from that assms obtain a f 
+      where C_def: "C = [a, 0, f]\<^sub>\<circ>"
+        and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+      by auto
+    from a c assms f show ?thesis
+      unfolding C_def 
+      by
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )
+  qed
 qed
+  (
+    use assms in
+      \<open>
+        cs_concl
+          cs_simp: cat_comma_cs_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros
+      \<close>
+  )+
+
+lemma (in is_functor) cf_arr_cf_comma_is_functor'[cat_comma_cs_intros]:
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'" and "\<AA>' = c' \<down>\<^sub>C\<^sub>F \<FF>" and "\<BB>' = c \<down>\<^sub>C\<^sub>F \<FF>"
+  shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
+  using assms(1) unfolding assms(2,3) by (rule cf_arr_cf_comma_is_functor(1))
+
+lemmas [cat_comma_cs_intros] = is_functor.cf_arr_cf_comma_is_functor'
 
 lemma (in is_functor) cf_cf_arr_comma_is_functor'[cat_comma_cs_intros]:
-  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'" and "\<AA>' = c' \<down>\<^sub>C\<^sub>F \<FF>" and "\<BB>' = c \<down>\<^sub>C\<^sub>F \<FF>"
-  shows "g \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'" and "\<AA>' = \<FF> \<^sub>C\<^sub>F\<down> c" and "\<BB>' = \<FF> \<^sub>C\<^sub>F\<down> c'"
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1) unfolding assms(2,3) by (rule cf_cf_arr_comma_is_functor(1))
 
 lemmas [cat_comma_cs_intros] = is_functor.cf_cf_arr_comma_is_functor'
 
-lemma (in is_functor) cf_cf_arr_comma_CId:
+lemma (in is_functor) cf_arr_cf_comma_CId:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)"
-proof-
-
-  show ?thesis
-  proof(rule cf_eqI)
-    from vempty_is_zet assms show "cf_id (b \<down>\<^sub>C\<^sub>F \<FF>) : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    from vempty_is_zet assms show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    from assms have ObjMap_dom_lhs: 
-      "\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
-    from assms have ObjMap_dom_rhs: 
-      "\<D>\<^sub>\<circ> (dghm_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
-    show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>"
-    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
-      fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      with assms obtain a' f' 
-        where A_def: "A = [0, a', f']\<^sub>\<circ>"
-          and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-          and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
-        by auto
-      from prems assms vempty_is_zet a' f' show 
-        "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
-        unfolding A_def
-        by 
-          (
-            cs_concl
-              cs_simp: cat_cs_simps cat_comma_cs_simps 
-              cs_intro: cat_cs_intros
-          )
-    qed (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)+
-
-    from assms have ArrMap_dom_lhs: 
-      "\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-      by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
-    from assms have ArrMap_dom_rhs: 
-      "\<D>\<^sub>\<circ> (dghm_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
-
-    show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>"
-    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
-      fix F assume prems: "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-      then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" by (auto dest: is_arrI)
-      from assms F obtain b' f' b'' f'' h
-        where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
-          and A_def: "A = [0, b', f']\<^sub>\<circ>"
-          and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
-          and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
-          and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
-          and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
-          and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
-        by auto
-      from assms prems F h f' f'' show 
-        "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
-        unfolding F_def A_def B_def
-        by 
-          (
-            cs_concl
-              cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
-          )
-    qed (cs_concl cs_intro: cat_comma_cs_intros cat_cs_intros)+
-
-  qed simp_all
-
-qed
+proof(rule cf_eqI)
+  from vempty_is_zet assms show "cf_id (b \<down>\<^sub>C\<^sub>F \<FF>) : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from vempty_is_zet assms show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> b \<down>\<^sub>C\<^sub>F \<FF>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms have ObjMap_dom_lhs: 
+    "\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
+  from assms have ObjMap_dom_rhs: 
+    "\<D>\<^sub>\<circ> (cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>"
+  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+    fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    with assms obtain a' f' 
+      where A_def: "A = [0, a', f']\<^sub>\<circ>"
+        and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
+      by auto
+    from prems assms vempty_is_zet a' f' show 
+      "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+      unfolding A_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps 
+            cs_intro: cat_cs_intros
+        )
+  qed (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)+
+  from assms have ArrMap_dom_lhs: 
+    "\<D>\<^sub>\<circ> ((\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
+  from assms have ArrMap_dom_rhs: 
+    "\<D>\<^sub>\<circ> (cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  show "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>"
+  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+    fix F assume prems: "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B" by (auto dest: is_arrI)
+    from assms F obtain b' f' b'' f'' h
+      where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [0, b', f']\<^sub>\<circ>"
+        and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
+        and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
+        and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+        and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
+        and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
+      by auto
+    from assms prems F h f' f'' show 
+      "(\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = cf_id (b \<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      unfolding F_def A_def B_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
+        )
+  qed (cs_concl cs_intro: cat_comma_cs_intros cat_cs_intros)+
+qed simp_all
+
+lemma (in is_functor) cf_cf_arr_comma_CId:
+  assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
+  shows "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)"
+proof(rule cf_eqI)
+  from vempty_is_zet assms show "cf_id (\<FF> \<^sub>C\<^sub>F\<down> b) : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> b"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from vempty_is_zet assms show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>) : \<FF> \<^sub>C\<^sub>F\<down> b \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<FF> \<^sub>C\<^sub>F\<down> b"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms have ObjMap_dom_lhs: 
+    "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
+  from assms have ObjMap_dom_rhs:
+    "\<D>\<^sub>\<circ> (cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>"
+  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+    fix A assume prems: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Obj\<rparr>"
+    with assms obtain a' f' 
+      where A_def: "A = [a', 0, f']\<^sub>\<circ>"
+        and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+      by auto
+    from prems assms vempty_is_zet a' f' show 
+      "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+      unfolding A_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
+        )
+  qed (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)+
+  from assms have ArrMap_dom_lhs: 
+    "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
+  from assms have ArrMap_dom_rhs: 
+    "\<D>\<^sub>\<circ> (cf_id (\<FF> \<down>\<^sub>C\<^sub>F b)\<lparr>ArrMap\<rparr>) = \<FF> \<down>\<^sub>C\<^sub>F b\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  show "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ArrMap\<rparr>"
+  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+    fix F assume prems: "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> b\<lparr>Arr\<rparr>"
+    then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> b\<^esub> B" by (auto dest: is_arrI)
+    from assms F obtain a' f' a'' f'' k
+      where F_def: "F = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [k, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [a', 0, f']\<^sub>\<circ>"
+        and B_def: "B = [a'', 0, f'']\<^sub>\<circ>"
+        and k: "k : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+        and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> b"
+        and [cat_cs_simps]: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = f'"
+      by auto
+    from assms prems F k f' f'' show 
+      "\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A (\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = cf_id (\<FF> \<^sub>C\<^sub>F\<down> b)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      unfolding F_def A_def B_def
+      by 
+        (
+          cs_concl
+            cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
+        )
+  qed
+    (
+      cs_concl
+        cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros cat_cs_intros
+    )+
+qed simp_all
 
 
 subsubsection\<open>Comma functors and projections\<close>
 
 lemma (in is_functor) 
-  cf_cf_comp_cf_obj_cf_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]: 
+  cf_cf_comp_cf_obj_cf_comma_proj_cf_arr_cf_comma[cat_comma_cs_simps]: 
   assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
   shows "a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>"
-proof-
-
-  show ?thesis
-  proof(rule cf_eqI)
-    from assms vempty_is_zet show "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    from assms show 
-      "a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
-      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
-    from assms have ObjMap_dom_lhs:
-      "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+proof(rule cf_eqI)
+  from assms vempty_is_zet show "b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms show 
+    "a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF> : b \<down>\<^sub>C\<^sub>F \<FF> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms have ObjMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by 
+      ( 
+        cs_concl 
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps)
+  show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>"
+  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+    from assms show "vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>)"
+      by (cs_concl cs_intro: cat_comma_cs_intros)
+    fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    with assms obtain b' f' 
+      where A_def: "A = [0, b', f']\<^sub>\<circ>"
+        and b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+      by auto
+    from prems assms b' f' show 
+      "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+      unfolding A_def
       by 
-        ( 
+        (
           cs_concl 
-            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+            cs_simp: cat_cs_simps cat_comma_cs_simps 
+            cs_intro: cat_cs_intros cat_comma_cs_intros
         )
-    from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      by (cs_concl cs_simp: cat_comma_cs_simps)
-    show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>"
-    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
-      from assms show "vsv (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>)"
-        by (cs_concl cs_intro: cat_comma_cs_intros)
-      fix A assume prems: "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      with assms obtain b' f' 
-        where A_def: "A = [0, b', f']\<^sub>\<circ>"
-          and b': "b' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
-          and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
-        by auto
-      from prems assms b' f' show 
-        "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
-        unfolding A_def
-        by 
-          (
-            cs_concl 
-              cs_simp: cat_cs_simps cat_comma_cs_simps 
-              cs_intro: cat_cs_intros cat_comma_cs_intros
-          )
-    qed
+  qed
+    (
+      use assms vempty_is_zet in
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
+    )
+  from assms have ArrMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by
       (
-        use assms vempty_is_zet in
-          \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
+        cs_concl
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
       )
-    from assms have ArrMap_dom_lhs:
-      "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+  from assms vempty_is_zet have ArrMap_dom_rhs:
+    "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps)
+  from assms vempty_is_zet have ArrMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps)
+  show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>"
+  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+    fix F assume "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+    then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
+      by (auto dest: is_arrI)
+    with assms obtain b' f' b'' f'' h
+      where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [0, b', f']\<^sub>\<circ>"
+        and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
+        and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
+        and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
+        and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
+        and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
+      by auto
+    from vempty_is_zet h assms f' f'' F show
+      "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      unfolding F_def A_def B_def 
+      by (*slow*)
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )+
+  qed
+    (
+      use assms vempty_is_zet in
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
+    )
+qed simp_all
+
+lemma (in is_functor) 
+  cf_cf_comp_cf_cf_obj_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]: 
+  assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
+  shows "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a"
+proof(rule cf_eqI)
+  from assms vempty_is_zet show "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a : \<FF> \<^sub>C\<^sub>F\<down> a \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms show "\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f : \<FF> \<^sub>C\<^sub>F\<down> a \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
+  from assms have ObjMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
+    by 
+      ( 
+        cs_concl 
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps)
+  show "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>"
+  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+    from assms show "vsv (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>)"
+      by (cs_concl cs_intro: cat_comma_cs_intros)
+    fix A assume prems: "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Obj\<rparr>"
+    with assms obtain a' f' 
+      where A_def: "A = [a', 0, f']\<^sub>\<circ>"
+        and b': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
+      by auto
+    from prems assms b' f' show
+      "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+      unfolding A_def
       by
         (
           cs_concl
-            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+            cs_simp: cat_cs_simps cat_comma_cs_simps 
+            cs_intro: cat_cs_intros cat_comma_cs_intros
         )
-    from assms vempty_is_zet have ArrMap_dom_rhs:
-      "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ObjMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Obj\<rparr>"
-      by (cs_concl cs_simp: cat_comma_cs_simps)
-    from assms vempty_is_zet have ArrMap_dom_lhs:
-      "\<D>\<^sub>\<circ> ((a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
+  qed
+    (
+      use assms vempty_is_zet in
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
+    )
+  from assms vempty_is_zet have ArrMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>) = \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_comma_cs_simps)
+  show "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>"
+  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+    fix F assume "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> a\<lparr>Arr\<rparr>"
+    then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> a\<^esub> B" by (auto dest: is_arrI)
+    with assms obtain a' f' a'' f'' k
+      where F_def: "F = [[a', 0, f']\<^sub>\<circ>, [a'', 0, f'']\<^sub>\<circ>, [k, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [a', 0, f']\<^sub>\<circ>"
+        and B_def: "B = [a'', 0, f'']\<^sub>\<circ>"
+        and k: "k : a' \<mapsto>\<^bsub>\<AA>\<^esub> a''"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
+        and f'': "f'' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> a"
+        and f'_def: "f'' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> = f'"
+      by auto
+    from vempty_is_zet k assms f' f'' F show
+      "(\<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O b \<circ>\<^sub>C\<^sub>F \<FF> \<^sub>C\<^sub>F\<down>\<^sub>A f)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = \<FF> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      unfolding F_def A_def B_def 
+      by (*slow*)
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
+            cs_intro: cat_cs_intros cat_comma_cs_intros
+        )+
+  qed
+    (
+      use assms vempty_is_zet in
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
+    )
+qed simp_all
+
+
+subsubsection\<open>Opposite comma functors\<close>
+
+lemma (in is_functor) cf_op_cf_obj_comma_cf_arr_cf_comma:
+  assumes "g : c \<mapsto>\<^bsub>\<BB>\<^esub> c'"
+  shows 
+    "op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) =
+      g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c"
+proof(rule cf_eqI)
+  from assms interpret \<FF>c: category \<alpha> \<open>\<FF> \<^sub>C\<^sub>F\<down> c\<close>
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms have c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
+  from assms show "op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g) :
+    op_cat (\<FF> \<^sub>C\<^sub>F\<down> c) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c' \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  then have ObjMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr>) =
+      (op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Obj\<rparr>"
+    and ArrMap_dom_lhs:
+    "\<D>\<^sub>\<circ> ((op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr>) =
+      (op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps)+
+  from assms show 
+    "g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c :
+      op_cat (\<FF> \<^sub>C\<^sub>F\<down> c) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> c' \<down>\<^sub>C\<^sub>F (op_cf \<FF>)"
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cat_op_simps
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  then have ObjMap_dom_rhs:
+    "\<D>\<^sub>\<circ> ((g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>) =
+      (op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Obj\<rparr>"
+    and ArrMap_dom_rhs:
+    "\<D>\<^sub>\<circ> ((g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>) =
+      (op_cat (\<FF> \<^sub>C\<^sub>F\<down> c))\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps)+
+  show
+    "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr> =
+      (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>"
+  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_op_simps)
+    fix A assume "A \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Obj\<rparr>"
+    with assms obtain a f
+      where A_def: "A = [a, 0, f]\<^sub>\<circ>" 
+        and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
+        and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+      by auto
+    from assms a f show 
+      "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
+        (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_cf_obj_comma \<FF> c)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
+      unfolding A_def 
       by
         (
           cs_concl
-            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+            cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
         )
-    from assms have ArrMap_dom_rhs:
-      "\<D>\<^sub>\<circ> (b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-      by (cs_concl cs_simp: cat_comma_cs_simps)
-    show "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>"
-    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
-      fix F assume "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<FF>\<lparr>Arr\<rparr>"
-      then obtain A B where F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<FF>\<^esub> B"
-        by (auto dest: is_arrI)
-      with assms obtain b' f' b'' f'' h
-        where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h]\<^sub>\<circ>]\<^sub>\<circ>"
-          and A_def: "A = [0, b', f']\<^sub>\<circ>"
-          and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
-          and h: "h : b' \<mapsto>\<^bsub>\<AA>\<^esub> b''"
-          and f': "f' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
-          and f'': "f'' : b \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
-          and f''_def: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f' = f''"
-        by auto
-      from vempty_is_zet h assms f' f'' F show
-        "(a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<FF>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
-        unfolding F_def A_def B_def 
-        by (*slow*)
-          (
-            cs_concl
-              cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
-              cs_intro: cat_cs_intros cat_comma_cs_intros
-          )+
-    qed
-      (
-        use assms vempty_is_zet in
-          \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>
-      )
-  qed simp_all
-
-qed
+  qed 
+    (
+      use assms in 
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros\<close>
+    )+
+  show 
+    "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr> =
+      (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>"
+  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs cat_op_simps)
+    fix F assume "F \<in>\<^sub>\<circ> \<FF> \<^sub>C\<^sub>F\<down> c\<lparr>Arr\<rparr>"
+    then obtain A B where F: "F : A \<mapsto>\<^bsub>\<FF> \<^sub>C\<^sub>F\<down> c\<^esub> B" by auto
+    with assms c obtain a f a' f' h
+      where F_def: "F = [[a, 0, f]\<^sub>\<circ>, [a', 0, f']\<^sub>\<circ>, [h, 0]\<^sub>\<circ>]\<^sub>\<circ>"
+        and A_def: "A = [a, 0, f]\<^sub>\<circ>"
+        and B_def: "B = [a', 0, f']\<^sub>\<circ>"
+        and h: "h : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
+        and f: "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and f': "f' : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> c"
+        and [cat_comma_cs_simps]: "f' \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>h\<rparr> = f"
+      by auto
+    from F assms h f f' c show 
+      "(op_cf_obj_comma \<FF> c' \<circ>\<^sub>C\<^sub>F op_cf (\<FF> \<^sub>C\<^sub>F\<down>\<^sub>A g))\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
+        (g \<^sub>A\<down>\<^sub>C\<^sub>F (op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<FF> c)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
+      unfolding F_def A_def B_def
+      by
+        (
+          cs_concl
+            cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
+            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+        )
+  qed
+    (
+      use assms in
+        \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros\<close>
+    )+
+qed simp_all
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Functor.thy
@@ -1,2042 +1,2076 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Functor\<close>
 theory CZH_ECAT_Functor
   imports 
     CZH_ECAT_Category
     CZH_Foundations.CZH_SMC_Semifunctor
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems cf_cs_simps
 named_theorems cf_cs_intros
 
 named_theorems cat_cn_cs_simps
 named_theorems cat_cn_cs_intros
 
 lemmas [cat_cs_simps] = dg_shared_cs_simps
 lemmas [cat_cs_intros] = dg_shared_cs_intros
 
 
 subsubsection\<open>Slicing\<close>
 
 definition cf_smcf :: "V \<Rightarrow> V"
   where "cf_smcf \<CC> = 
     [\<CC>\<lparr>ObjMap\<rparr>, \<CC>\<lparr>ArrMap\<rparr>, cat_smc (\<CC>\<lparr>HomDom\<rparr>), cat_smc (\<CC>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_smcf_components:
   shows [slicing_simps]: "cf_smcf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and [slicing_simps]: "cf_smcf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and [slicing_commute]: "cf_smcf \<FF>\<lparr>HomDom\<rparr> = cat_smc (\<FF>\<lparr>HomDom\<rparr>)"
     and [slicing_commute]: "cf_smcf \<FF>\<lparr>HomCod\<rparr> = cat_smc (\<FF>\<lparr>HomCod\<rparr>)"
   unfolding cf_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)
 
 
 
 subsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_functor = 
   \<Z> \<alpha> + vfsequence \<FF> + HomDom: category \<alpha> \<AA> + HomCod: category \<alpha> \<BB> 
   for \<alpha> \<AA> \<BB> \<FF> +
   assumes cf_length[cat_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>" 
     and cf_is_semifunctor[slicing_intros]: 
       "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>" 
     and cf_HomDom[cat_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and cf_HomCod[cat_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and cf_ObjMap_CId[cat_cs_intros]: 
       "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
 
 syntax "_is_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_functor \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation (input) is_cn_cf :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   where "is_cn_cf \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 
 syntax "_is_cn_cf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<^sub>C\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_cf \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation all_cfs :: "V \<Rightarrow> V"
   where "all_cfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 abbreviation cfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 lemmas [cat_cs_simps] =
   is_functor.cf_length
   is_functor.cf_HomDom
   is_functor.cf_HomCod
   is_functor.cf_ObjMap_CId
 
 lemma cn_cf_ObjMap_CId[cat_cn_cs_simps]: 
   assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
 proof-
   interpret is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(1))
   from assms(2) have c: "c \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   show ?thesis by (rule cf_ObjMap_CId[OF c, unfolded cat_op_simps])
 qed
 
 lemma (in is_functor) cf_is_semifunctor':
   assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule cf_is_semifunctor)
 
 lemmas [slicing_intros] = is_functor.cf_is_semifunctor'
 
 lemma cn_smcf_comp_is_semifunctor: 
   assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "cf_smcf \<FF> : cat_smc \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub>cat_smc \<BB>"
   using assms 
   unfolding slicing_simps slicing_commute
   by (rule is_functor.cf_is_semifunctor)
 
 lemma cn_smcf_comp_is_semifunctor'[slicing_intros]: 
   assumes "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<AA>' = op_smc (cat_smc \<AA>)"
     and "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1) unfolding assms(2,3) by (rule cn_smcf_comp_is_semifunctor)
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_functor) is_functor_axioms'[cat_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_functor_axioms)
 
 mk_ide rf is_functor_def[unfolded is_functor_axioms_def]
   |intro is_functorI|
   |dest is_functorD[dest]|
   |elim is_functorE[elim]|
 
 lemmas [cat_cs_intros] = is_functorD(3,4)
 
 lemma is_functorI':
   assumes "\<Z> \<alpha>"
     and "vfsequence \<FF>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   by 
     (
       intro is_functorI is_semifunctorI', 
       unfold cf_smcf_components slicing_simps
     )
     (simp_all add: assms cf_smcf_def nat_omega_simps category.cat_semicategory)
 
 lemma is_functorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<Z> \<alpha>"
     and "vfsequence \<FF>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
   by 
     (
       simp_all add: 
         is_functorD(2-9)[OF assms] 
         is_semifunctorD'[OF is_functorD(6)[OF assms], unfolded slicing_simps]
     )
 
 lemma is_functorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<Z> \<alpha>"
     and "vfsequence \<FF>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     and "(\<And>c. c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
   using assms by (simp add: is_functorD')
 
 
 text\<open>A functor is a semifunctor.\<close>
 
 context is_functor
 begin
 
 interpretation smcf: is_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
   by (rule cf_is_semifunctor)
 
 sublocale ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   by (rule smcf.ObjMap.vsv_axioms[unfolded slicing_simps])
 sublocale ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   by (rule smcf.ArrMap.vsv_axioms[unfolded slicing_simps])
 
 lemmas_with [unfolded slicing_simps]:
   cf_ObjMap_vsv = smcf.smcf_ObjMap_vsv
   and cf_ArrMap_vsv = smcf.smcf_ArrMap_vsv
   and cf_ObjMap_vdomain[cat_cs_simps] = smcf.smcf_ObjMap_vdomain
   and cf_ObjMap_vrange = smcf.smcf_ObjMap_vrange
   and cf_ArrMap_vdomain[cat_cs_simps] = smcf.smcf_ArrMap_vdomain
   and cf_ArrMap_is_arr = smcf.smcf_ArrMap_is_arr
   and cf_ArrMap_is_arr''[cat_cs_intros] = smcf.smcf_ArrMap_is_arr''
   and cf_ArrMap_is_arr'[cat_cs_intros] = smcf.smcf_ArrMap_is_arr'
   and cf_ObjMap_app_in_HomCod_Obj[cat_cs_intros] = 
     smcf.smcf_ObjMap_app_in_HomCod_Obj
   and cf_ArrMap_vrange = smcf.smcf_ArrMap_vrange
   and cf_ArrMap_app_in_HomCod_Arr[cat_cs_intros] = 
     smcf.smcf_ArrMap_app_in_HomCod_Arr
   and cf_ObjMap_vsubset_Vset = smcf.smcf_ObjMap_vsubset_Vset
   and cf_ArrMap_vsubset_Vset = smcf.smcf_ArrMap_vsubset_Vset
   and cf_ObjMap_in_Vset = smcf.smcf_ObjMap_in_Vset
   and cf_ArrMap_in_Vset = smcf.smcf_ArrMap_in_Vset
   and cf_is_semifunctor_if_ge_Limit = smcf.smcf_is_semifunctor_if_ge_Limit
   and cf_is_arr_HomCod = smcf.smcf_is_arr_HomCod
   and cf_vimage_dghm_ArrMap_vsubset_Hom = 
     smcf.smcf_vimage_dghm_ArrMap_vsubset_Hom
 
 lemmas_with [unfolded slicing_simps]: 
   cf_ArrMap_Comp = smcf.smcf_ArrMap_Comp
 
 end
 
 lemmas [cat_cs_simps] = 
   is_functor.cf_ObjMap_vdomain
   is_functor.cf_ArrMap_vdomain
   is_functor.cf_ArrMap_Comp
 
 lemmas [cat_cs_intros] =
   is_functor.cf_ObjMap_app_in_HomCod_Obj
   is_functor.cf_ArrMap_app_in_HomCod_Arr
   is_functor.cf_ArrMap_is_arr'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma cn_cf_ArrMap_Comp[cat_cn_cs_simps]: 
   assumes "category \<alpha> \<AA>" 
     and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
     and "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b"
     and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" 
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule cn_smcf_ArrMap_Comp
           [
             OF 
               \<AA>.cat_semicategory 
               \<FF>.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_simps,
             OF assms(3,4)
           ]
       )
 qed
 
 lemma cf_eqI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
   shows "\<GG> = \<FF>"
 proof(rule vsv_eqI)
   interpret L: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   from assms(1) show "vsv \<GG>" by auto
   from assms(2) show "vsv \<FF>" by auto
   have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
   show "\<D>\<^sub>\<circ> \<GG> = \<D>\<^sub>\<circ> \<FF>" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
   from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>" 
     by (simp_all add: cat_cs_simps)
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a 
     by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
       (auto simp: dghm_field_simps)
 qed
 
 lemma cf_smcf_eqI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
     and "cf_smcf \<GG> = cf_smcf \<FF>"
   shows "\<GG> = \<FF>"
 proof(rule cf_eqI)
   from assms(5) have 
     "cf_smcf \<GG>\<lparr>ObjMap\<rparr> = cf_smcf \<FF>\<lparr>ObjMap\<rparr>"
     "cf_smcf \<GG>\<lparr>ArrMap\<rparr> = cf_smcf \<FF>\<lparr>ArrMap\<rparr>"
     by simp_all
   then show "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     unfolding slicing_simps by simp_all
 qed (auto intro: assms(1,2) simp: assms(3-5))
 
 lemma (in is_functor) cf_def: "\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>Obj\<rparr>, \<FF>\<lparr>Arr\<rparr>, \<FF>\<lparr>Dom\<rparr>, \<FF>\<lparr>Cod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
     by (simp add: nat_omega_simps)
   then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
     unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" 
     for a
     by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
       (simp_all add: nat_omega_simps)
 qed (auto simp: vsv_axioms)
 
 
 text\<open>Size.\<close>
 
 lemma (in is_functor) cf_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"  
   shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   note [cat_cs_intros] = 
     cf_ObjMap_in_Vset 
     cf_ArrMap_in_Vset 
     HomDom.cat_in_Vset 
     HomCod.cat_in_Vset
   from assms(2) show ?thesis
     by (subst cf_def) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
 qed
 
 lemma (in is_functor) cf_is_functor_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
   by (rule is_functorI)
     (
       auto simp:
         cat_cs_simps
         assms 
         vfsequence_axioms
         cf_is_semifunctor_if_ge_Limit
         HomDom.cat_category_if_ge_Limit
         HomCod.cat_category_if_ge_Limit
         intro: cat_cs_intros 
     )
 
 lemma small_all_cfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 proof(cases \<open>\<Z> \<alpha>\<close>)
   case True
   from is_functor.cf_in_Vset show ?thesis
     by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
       (auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
 next
   case False
   then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
   then show ?thesis by simp
 qed
 
 lemma (in is_functor) cf_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
 proof-
   note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], cat_cs_intros] =
     cf_ObjMap_vsubset_Vset 
     cf_ArrMap_vsubset_Vset
   from HomDom.cat_category_in_Vset_4 have [cat_cs_intros]:
     "\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   from HomCod.cat_category_in_Vset_4 have [cat_cs_intros]:
     "\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   show ?thesis
     by (subst cf_def, succ_of_numeral)
       (
         cs_concl 
           cs_simp: plus_V_succ_right V_cs_simps cat_cs_simps 
           cs_intro: cat_cs_intros V_cs_intros
       )
 qed
 
 lemma (in \<Z>) all_cfs_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "all_cfs \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
 proof(rule vsubset_in_VsetI)
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   show "all_cfs \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
   proof(intro vsubsetI)
     fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_cfs \<alpha>"
     then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
     interpret is_functor \<alpha> \<AA> \<BB> \<FF> using \<FF> by simp
     show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule cf_in_Vset_7)
   qed
   from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
     by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
 qed
 
 lemma small_cfs[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
   by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto
 
 
 
 subsection\<open>Opposite functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition op_cf :: "V \<Rightarrow> V"
   where "op_cf \<FF> =
     [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_cat (\<FF>\<lparr>HomDom\<rparr>), op_cat (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma op_cf_components[cat_op_simps]:
   shows "op_cf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "op_cf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "op_cf \<FF>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>)"
     and "op_cf \<FF>\<lparr>HomCod\<rparr> = op_cat (\<FF>\<lparr>HomCod\<rparr>)"
   unfolding op_cf_def dghm_field_simps by (auto simp: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_op_cf[slicing_commute]: "op_smcf (cf_smcf \<FF>) = cf_smcf (op_cf \<FF>)"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) = 4\<^sub>\<nat>"
     unfolding op_smcf_def by (auto simp: nat_omega_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> (cf_smcf (op_cf \<FF>)) = 4\<^sub>\<nat>"
     unfolding cf_smcf_def by (auto simp: nat_omega_simps)
   show "\<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) = \<D>\<^sub>\<circ> (cf_smcf (op_cf \<FF>))"
     unfolding dom_lhs dom_rhs by simp
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_smcf (cf_smcf \<FF>)) \<Longrightarrow> 
     op_smcf (cf_smcf \<FF>)\<lparr>a\<rparr> = cf_smcf (op_cf \<FF>)\<lparr>a\<rparr>"
     for a
     by 
       (
         unfold dom_lhs, 
         elim_in_numeral,
         unfold cf_smcf_def op_cf_def op_smcf_def dghm_field_simps
       )
       (auto simp: nat_omega_simps slicing_commute)
 qed (auto simp: cf_smcf_def op_smcf_def)
 
 
 text\<open>Elementary properties.\<close>
 
 lemma op_cf_vsv[cat_op_intros]: "vsv (op_cf \<FF>)" unfolding op_cf_def by auto
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_functor) is_functor_op: "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
 proof(intro is_functorI, unfold cat_op_simps)
   show "vfsequence (op_cf \<FF>)" unfolding op_cf_def by simp
   show "vcard (op_cf \<FF>) = 4\<^sub>\<nat>" 
     unfolding op_cf_def by (auto simp: nat_omega_simps)
   fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   then show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
     unfolding cat_op_simps by (auto intro: cat_cs_intros)
 qed 
   (
     auto simp: 
       cat_cs_simps
       slicing_commute[symmetric]
       is_semifunctor.is_semifunctor_op 
       cf_is_semifunctor
       HomCod.category_op 
       HomDom.category_op
   )
 
 lemma (in is_functor) is_functor_op'[cat_op_intros]: 
   assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
   shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms(1,2) by (rule is_functor_op)
 
 lemmas is_functor_op[cat_op_intros] = is_functor.is_functor_op'
 
 lemma (in is_functor) cf_op_cf_op_cf[cat_op_simps]: "op_cf (op_cf \<FF>) = \<FF>" 
 proof(rule cf_eqI[of \<alpha> \<AA> \<BB> _ \<AA> \<BB>], unfold cat_op_simps)
   show "op_cf (op_cf \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by 
       (
         metis 
           HomCod.cat_op_cat_op_cat 
           HomDom.cat_op_cat_op_cat 
           is_functor.is_functor_op 
           is_functor_op
       )
 qed (auto simp: cat_cs_intros)
 
 lemmas cf_op_cf_op_cf[cat_op_simps] = is_functor.cf_op_cf_op_cf
 
 lemma eq_op_cf_iff[cat_op_simps]: 
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "op_cf \<GG> = op_cf \<FF> \<longleftrightarrow> \<GG> = \<FF>"
 proof
   interpret L: is_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_functor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   assume prems: "op_cf \<GG> = op_cf \<FF>"
   show "\<GG> = \<FF>"
   proof(rule cf_eqI[OF assms])
     from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf show 
       "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
       by metis+
     from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf have 
       "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
       by auto
     then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (simp_all add: cat_cs_simps)
   qed
 qed auto
 
 
 
 subsection\<open>Composition of covariant functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 abbreviation (input) cf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>C\<^sub>F" 55)
   where "cf_comp \<equiv> dghm_comp"
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_smcf_comp[slicing_commute]: 
   "cf_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> = cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
   unfolding dghm_comp_def cf_smcf_def dghm_field_simps 
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_comp_ObjMap_vsv[cat_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ObjMap_vsv
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ObjMap_vdomain[cat_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ObjMap_vdomain
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ObjMap_vrange
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ObjMap_app[cat_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ObjMap_app
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute, 
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_comp_ArrMap_vsv[cat_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by 
       (
         rule smcf_comp_ArrMap_vsv
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ArrMap_vdomain[cat_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by 
       (
         rule smcf_comp_ArrMap_vdomain
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ArrMap_vrange
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma cf_comp_ArrMap_app[cat_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and [simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_comp_ArrMap_app
           [
             OF L.cf_is_semifunctor R.cf_is_semifunctor, 
             unfolded slicing_simps slicing_commute,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma cf_comp_is_functorI[cat_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule is_functorI, unfold dghm_comp_components(3,4))
     show "vfsequence (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)" by (simp add: dghm_comp_def)
     show "vcard (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"  
       unfolding dghm_comp_def by (simp add: nat_omega_simps)
     show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       unfolding cf_smcf_smcf_comp[symmetric] 
       by (cs_concl cs_intro: smc_cs_intros slicing_intros cat_cs_intros)
     fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: cat_cs_simps intro: cat_cs_intros)
 qed
 
 lemma cf_comp_assoc[cat_cs_simps]:
   assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>C\<^sub>F \<FF> = \<HH> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
 proof(rule cf_eqI[of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
   interpret \<HH>: is_functor \<alpha> \<CC> \<DD> \<HH> by (rule assms(1)) 
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2)) 
   interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3)) 
   from \<FF>.is_functor_axioms \<GG>.is_functor_axioms \<HH>.is_functor_axioms 
   show "\<HH> \<circ>\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "\<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"  
     by (auto simp: cat_cs_simps intro: cat_cs_intros)
 qed (simp_all add: dghm_comp_components vcomp_assoc)
 
 
 text\<open>The opposite of the covariant composition of functors.\<close>
 
 lemma op_cf_cf_comp[cat_op_simps]: "op_cf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<FF>"
   unfolding dghm_comp_def op_cf_def dghm_field_simps
   by (simp add: nat_omega_simps)
 
 
 
 subsection\<open>Composition of contravariant functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
 
 definition cf_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<^sub>C\<^sub>F\<circ>" 55)
   where "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> =
     [
       \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>,
       \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>,
       op_cat (\<FF>\<lparr>HomDom\<rparr>),
       \<GG>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_cn_comp_components:
   shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
     and [cat_cn_cs_simps]: "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>)"
     and [cat_cn_cs_simps]: "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
   unfolding cf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_cf_cn_comp[slicing_commute]: 
   "cf_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> cf_smcf \<FF> = cf_smcf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)"
   unfolding smcf_cn_comp_def cf_cn_comp_def cf_smcf_def  
   by (simp add: nat_omega_simps slicing_commute dghm_field_simps)
 
 
 subsubsection\<open>Object map: two contravariant functors\<close>
 
 lemma cf_cn_comp_ObjMap_vsv[cat_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ObjMap_vsv
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ObjMap_vdomain[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ObjMap_vdomain
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ObjMap_vrange
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ObjMap_app[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ObjMap_app
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps, 
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map: two contravariant functors\<close>
 
 lemma cf_cn_comp_ArrMap_vsv[cat_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ArrMap_vsv
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ArrMap_vdomain[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ArrMap_vdomain
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ArrMap_vrange
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_comp_ArrMap_app[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_comp_ArrMap_app
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Object map: contravariant and covariant functor\<close>
 
 lemma cf_cn_cov_comp_ObjMap_vsv[cat_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ObjMap_vsv
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ObjMap_vdomain[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ObjMap_vdomain
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ObjMap_vrange
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ObjMap_app[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ObjMap_app
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map: contravariant and covariant functors\<close>
 
 lemma cf_cn_cov_comp_ArrMap_vsv[cat_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ArrMap_vsv
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
               R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ArrMap_vdomain[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ArrMap_vdomain
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ArrMap_vrange
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma cf_cn_cov_comp_ArrMap_app[cat_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule smcf_cn_cov_comp_ArrMap_app
           [
             OF 
               L.cf_is_semifunctor[unfolded slicing_commute[symmetric]] 
               R.cf_is_semifunctor,
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma cf_cn_comp_is_functorI[cat_cn_cs_intros]:
   assumes "category \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(2))
   interpret R: is_functor \<alpha> \<open>op_cat \<AA>\<close> \<BB> \<FF> by (rule assms(3))
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   show ?thesis
   proof(rule is_functorI, unfold cf_cn_comp_components(3,4) cat_op_simps)
     show "vfsequence (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)"
       unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
     show "vcard (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
       unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
     from assms(1) L.cf_is_semifunctor R.cf_is_semifunctor show 
       "cf_smcf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       unfolding cf_smcf_cf_cn_comp[symmetric] 
       by 
         (
           cs_concl cs_intro: 
             cat_cs_intros slicing_intros smc_cn_cs_intros
         )
     fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_op_simps cat_cn_cs_simps cs_intro: cat_cs_intros
         )
   qed (auto simp: cat_cs_simps cat_cs_intros cat_op_simps)
 qed
 
 
 text\<open>See section 1.2 in \cite{bodo_categories_1970}).\<close>
 
 lemma cf_cn_cov_comp_is_functor[cat_cn_cs_intros]:
   assumes "\<GG> : \<BB> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_functor \<alpha> \<open>op_cat \<BB>\<close> \<CC> \<GG> by (rule assms(1))
   interpret R: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof
     (
       rule is_functorI, 
       unfold cf_cn_comp_components(3,4) cat_op_simps slicing_commute[symmetric]
     )
     show "vfsequence (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)" unfolding cf_cn_comp_def by simp
     show "vcard (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
       unfolding cf_cn_comp_def by (auto simp: nat_omega_simps)
     from L.cf_is_semifunctor show 
       "cf_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> cf_smcf \<FF> : op_smc (cat_smc \<AA>) \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       by (cs_concl cs_intro: cat_cs_intros slicing_intros smc_cs_intros)
     fix c assume "c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show "(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>(\<GG> \<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_cn_cs_simps 
             cs_intro: cat_cs_intros
         )
   qed (auto simp: cat_cs_simps cat_cs_intros)
 qed
 
 
 text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
 
 lemma cf_cov_cn_comp_is_functor[cat_cn_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms by (rule cf_comp_is_functorI)
 
 
 text\<open>The opposite of the contravariant composition of functors.\<close>
 
 lemma op_cf_cf_cn_comp[cat_op_simps]: "op_cf (\<GG> \<^sub>C\<^sub>F\<circ> \<FF>) = op_cf \<GG> \<^sub>C\<^sub>F\<circ> op_cf \<FF>"
   unfolding op_cf_def cf_cn_comp_def dghm_field_simps 
   by (auto simp: nat_omega_simps)
 
 
 
 subsection\<open>Identity functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation (input) cf_id :: "V \<Rightarrow> V" where "cf_id \<equiv> dghm_id"
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_cf_id[slicing_commute]: "smcf_id (cat_smc \<CC>) = cf_smcf (cf_id \<CC>)"
   unfolding dghm_id_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
   by (simp add: nat_omega_simps)
 
 context category
 begin
 
 interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)
 
 lemmas_with [unfolded slicing_simps]:
   cat_smcf_id_is_semifunctor = smc.smc_smcf_id_is_semifunctor
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 lemmas [cat_cs_simps] = dghm_id_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemmas [cat_cs_simps] = dghm_id_ArrMap_app
 
 
 subsubsection\<open>Opposite of an identity functor.\<close>
 
 lemma op_cf_cf_id[cat_op_simps]: "op_cf (cf_id \<CC>) = cf_id (op_cat \<CC>)"
   unfolding dghm_id_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>An identity functor is a functor\<close>
 
 lemma (in category) cat_cf_id_is_functor: "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(rule is_functorI, unfold dghm_id_components)
   from cat_smcf_id_is_semifunctor show 
     "cf_smcf (cf_id \<CC>) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
     by (simp add: slicing_commute)
   from cat_CId_is_arr show 
     "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>vid_on (\<CC>\<lparr>Obj\<rparr>)\<lparr>c\<rparr>\<rparr>"
     for c
     by auto
 qed (auto simp: dghm_id_def nat_omega_simps cat_cs_intros)
 
 lemma (in category) cat_cf_id_is_functor': 
   assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
   shows "cf_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   unfolding assms by (rule cat_cf_id_is_functor)
 
 lemmas [cat_cs_intros] = category.cat_cf_id_is_functor'
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_functor) cf_cf_comp_cf_id_left[cat_cs_simps]: "cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<FF> = \<FF>"
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
   by 
     (
       rule cf_eqI,
       unfold dghm_id_components dghm_comp_components dghm_id_components
     )
     (auto intro: cat_cs_intros simp: cf_ArrMap_vrange cf_ObjMap_vrange)
 
 lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_left
 
 lemma (in is_functor) cf_cf_comp_cf_id_right[cat_cs_simps]: "\<FF> \<circ>\<^sub>C\<^sub>F cf_id \<AA> = \<FF>"
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
   by 
     (
       rule cf_eqI, 
       unfold dghm_id_components dghm_comp_components dghm_id_components
     )
     (
       auto 
         intro: cat_cs_intros 
         simp: cat_cs_simps cf_ArrMap_vrange cf_ObjMap_vrange 
     )
 
 lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_right
 
 
 
 subsection\<open>Constant functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation cf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_const \<CC> \<DD> a \<equiv> smcf_const \<CC> \<DD> a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>)"
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_cf_const[slicing_commute]: 
   "smcf_const (cat_smc \<CC>) (cat_smc \<DD>) a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>) = cf_smcf (cf_const \<CC> \<DD> a)"
   unfolding 
     dghm_const_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Object map and arrow map\<close>
 
 context
   fixes \<DD> a :: V
 begin
 
 lemmas_with [where \<DD>=\<DD> and a=a and f=\<open>\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<close>, cat_cs_simps]: 
   dghm_const_ObjMap_app
   dghm_const_ArrMap_app
 
 end
 
 
 subsubsection\<open>Opposite constant functor\<close>
 
 lemma op_cf_cf_const[cat_op_simps]:
   "op_cf (cf_const \<CC> \<DD> a) = cf_const (op_cat \<CC>) (op_cat \<DD>) a"
   unfolding dghm_const_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>A constant functor is a functor\<close>
 
 lemma cf_const_is_functor: 
   assumes "category \<alpha> \<CC>" and "category \<alpha> \<DD>" and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" 
   shows "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
   interpret \<DD>: category \<alpha> \<DD> by (rule assms(2))
   show ?thesis
   proof(intro is_functorI, tactic\<open>distinct_subgoals_tac\<close>)
     show "vfsequence (dghm_const \<CC> \<DD> a (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>))"
       unfolding dghm_const_def by simp
     show "vcard (cf_const \<CC> \<DD> a) = 4\<^sub>\<nat>"
       unfolding dghm_const_def by (simp add: nat_omega_simps)
     from assms show "cf_smcf (cf_const \<CC> \<DD> a) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<DD>"
       by 
         ( 
           cs_concl
             cs_simp: cat_cs_simps slicing_simps slicing_commute[symmetric] 
             cs_intro: smc_cs_intros cat_cs_intros slicing_intros
         )
     fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     with assms show 
       "cf_const \<CC> \<DD> a\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<DD>\<lparr>CId\<rparr>\<lparr>cf_const \<CC> \<DD> a\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: dghm_const_components assms)
 qed 
 
 lemma cf_const_is_functor'[cat_cs_intros]: 
   assumes "category \<alpha> \<CC>" 
     and "category \<alpha> \<DD>" 
     and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" 
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
     and "f = (\<DD>\<lparr>CId\<rparr>\<lparr>a\<rparr>)"
   shows "dghm_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms(1-3) unfolding assms(4-6) by (rule cf_const_is_functor)
 
 
+subsubsection\<open>Further properties\<close>
+
+lemma (in is_functor) cf_cf_comp_cf_const:
+  assumes "category \<alpha> \<CC>" and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+  shows "cf_const \<BB> \<CC> a \<circ>\<^sub>C\<^sub>F \<FF> = cf_const \<AA> \<CC> a"
+proof(rule cf_smcf_eqI)
+  interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
+  from assms(2) show "cf_const \<BB> \<CC> a \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_intro: cat_cs_intros)
+  from assms(2) show "cf_const \<AA> \<CC> a : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_intro: cat_cs_intros)
+  from assms(2) have CId_a: "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
+    by (cs_concl cs_intro: cat_cs_intros)
+  from assms(2) have CId_CId_a: "\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr> = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  from is_semifunctor.smcf_smcf_comp_smcf_const[
+    OF cf_is_semifunctor \<CC>.cat_semicategory, 
+    unfolded slicing_simps, 
+    OF CId_a CId_CId_a
+    ]
+  show "cf_smcf (cf_const \<BB> \<CC> a \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = cf_smcf (cf_const \<AA> \<CC> a)"
+    by (cs_prems cs_simp: slicing_simps slicing_commute)
+qed simp_all
+
+lemma (in is_functor) cf_cf_comp_cf_const'[cat_cs_simps]:
+  assumes "category \<alpha> \<CC>" 
+    and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+    and "f = \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>"
+  shows "dghm_const \<BB> \<CC> a f \<circ>\<^sub>C\<^sub>F \<FF> = cf_const \<AA> \<CC> a"
+  using assms(1,2) unfolding assms(3) by (rule cf_cf_comp_cf_const)
+
+lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_const'
+
+
 
 subsection\<open>Faithful functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_ft_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes ft_cf_is_ft_semifunctor[slicing_intros]: 
     "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
 
 syntax "_is_ft_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_functor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_ft_functor) ft_cf_is_ft_functor':
   assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule ft_cf_is_ft_semifunctor)
 
 lemmas [slicing_intros] = is_ft_functor.ft_cf_is_ft_functor'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_ft_functor) is_ft_functor_axioms'[cf_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_ft_functor_axioms)
 
 mk_ide rf is_ft_functor_def[unfolded is_ft_functor_axioms_def]
   |intro is_ft_functorI|
   |dest is_ft_functorD[dest]|
   |elim is_ft_functorE[elim]|
 
 lemmas [cf_cs_intros] = is_ft_functorD(1)
 
 lemma is_ft_functorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_ft_functorI)
     (
       simp_all add: 
         assms(1) 
         is_ft_semifunctorI'[OF is_functorD(6)[
           OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_ft_functorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   by 
     (
       simp_all add: 
         is_ft_functorD[OF assms(1)] 
         is_ft_semifunctorD'(2)[
           OF is_ft_functorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_ft_functorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   using assms by (simp_all add: is_ft_functorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_ft_functor
 begin
 
 interpretation smcf: is_ft_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
   by (rule ft_cf_is_ft_semifunctor) 
 
 lemmas_with [unfolded slicing_simps]:
   ft_cf_v11_on_Hom = smcf.ft_smcf_v11_on_Hom
 
 end
 
 
 subsubsection\<open>Opposite faithful functor.\<close>
 
 lemma (in is_ft_functor) is_ft_functor_op': 
   "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"   
   by (rule is_ft_functorI, unfold slicing_commute[symmetric])
     (
       simp_all add: 
         is_functor_op is_ft_semifunctor.is_ft_semifunctor_op 
         ft_cf_is_ft_semifunctor
     )
 
 lemma (in is_ft_functor) is_ft_functor_op: 
   assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
   shows "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"   
   unfolding assms by (rule is_ft_functor_op')
 
 lemmas is_ft_functor_op[cat_op_intros] = is_ft_functor.is_ft_functor_op'
 
 
 subsubsection\<open>The composition of faithful functors is a faithful functor\<close>
 
 lemma cf_comp_is_ft_functor[cf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_ft_functorI)
   interpret \<GG>: is_ft_functor \<alpha> \<BB> \<CC> \<GG> by (simp add: assms(1))
   interpret \<FF>: is_ft_functor \<alpha> \<AA> \<BB> \<FF> by (simp add: assms(2))
   from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   then interpret is_functor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> .
   show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>" 
     by 
       ( 
         cs_concl 
           cs_simp: slicing_commute[symmetric] 
           cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
       )
 qed
 
 
 
 subsection\<open>Full functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_fl_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes fl_cf_is_fl_semifunctor:
     "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
 
 syntax "_is_fl_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_functor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_fl_functor) fl_cf_is_fl_functor'[slicing_intros]:
   assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule fl_cf_is_fl_semifunctor)
 
 lemmas [slicing_intros] = is_fl_functor.fl_cf_is_fl_semifunctor
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_fl_functor) is_fl_functor_axioms'[cf_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_fl_functor_axioms)
 
 mk_ide rf is_fl_functor_def[unfolded is_fl_functor_axioms_def]
   |intro is_fl_functorI|
   |dest is_fl_functorD[dest]|
   |elim is_fl_functorE[elim]|
 
 lemmas [cf_cs_intros] = is_fl_functorD(1)
 
 lemma is_fl_functorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
     \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_fl_functorI)
     (
       simp_all add: 
         assms(1) 
         is_fl_semifunctorI'[
           OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_fl_functorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
     \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   by 
     (
       simp_all add: 
         is_fl_functorD[OF assms(1)] 
         is_fl_semifunctorD'(2)[
           OF is_fl_functorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_fl_functorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> 
     \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   using assms by (simp_all add: is_fl_functorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_fl_functor
 begin
 
 interpretation smcf: is_fl_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
   by (rule fl_cf_is_fl_semifunctor) 
 
 lemmas_with [unfolded slicing_simps]:
   fl_cf_surj_on_Hom = smcf.fl_smcf_surj_on_Hom
 
 end
 
 
 subsubsection\<open>Opposite full functor\<close>
 
 lemma (in is_fl_functor) is_fl_functor_op[cat_op_intros]: 
   "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_cat \<BB>"    
   by (rule is_fl_functorI, unfold slicing_commute[symmetric])
     (simp_all add: cat_op_intros smc_op_intros slicing_intros)
 
 lemmas is_fl_functor_op[cat_op_intros] = is_fl_functor.is_fl_functor_op
 
 
 subsubsection\<open>The composition of full functor is a full functor\<close>
 
 lemma cf_comp_is_fl_functor[cf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_fl_functorI)
   interpret \<FF>: is_fl_functor \<alpha> \<AA> \<BB> \<FF> using assms(2) by simp
   interpret \<GG>: is_fl_functor \<alpha> \<BB> \<CC> \<GG> using assms(1) by simp
   from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     by (cs_concl cs_intro: cat_cs_intros)
   show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<CC>" 
     by 
       (
         cs_concl 
           cs_simp: slicing_commute[symmetric] 
           cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
       )
 qed
 
 
 
 subsection\<open>Fully faithful functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_ff_functor = is_ft_functor \<alpha> \<AA> \<BB> \<FF> + is_fl_functor \<alpha> \<AA> \<BB> \<FF>
   for \<alpha> \<AA> \<BB> \<FF>
 
 syntax "_is_ff_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_functor \<alpha> \<AA> \<BB> \<FF>"
 
 
 text\<open>Rules.\<close>
 
 mk_ide rf is_ff_functor_def
   |intro is_ff_functorI|
   |dest is_ff_functorD[dest]|
   |elim is_ff_functorE[elim]|
 
 lemmas [cf_cs_intros] = is_ff_functorD
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_ff_functor) ff_cf_is_ff_semifunctor:
   "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
   by (rule is_ff_semifunctorI) (auto intro: slicing_intros)
 
 lemma (in is_ff_functor) ff_cf_is_ff_semifunctor'[slicing_intros]:
   assumes "\<AA>' = cat_smc \<AA>" and "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule ff_cf_is_ff_semifunctor)
 
 lemmas [slicing_intros] = is_ff_functor.ff_cf_is_ff_semifunctor'
 
 
 subsubsection\<open>Opposite fully faithful functor\<close>
 
 lemma (in is_ff_functor) is_ff_functor_op: 
   "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_cat \<BB>"    
   by (rule is_ff_functorI) (auto simp: is_fl_functor_op is_ft_functor_op)
 
 lemma (in is_ff_functor) is_ff_functor_op'[cat_op_intros]: 
   assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
   shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_ff_functor_op)
 
 lemmas is_ff_functor_op[cat_op_intros] = is_ff_functor.is_ff_functor_op
 
 
 subsubsection\<open>
 The composition of fully faithful functors is a fully faithful functor
 \<close>
 
 lemma cf_comp_is_ff_functor[cf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms 
   by (intro is_ff_functorI, elim is_ff_functorE) (auto simp: cf_cs_intros)
 
 
 
 subsection\<open>Isomorphism of categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_iso_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes iso_cf_is_iso_semifunctor: 
     "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
 
 syntax "_is_iso_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_functor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_iso_functor) iso_cf_is_iso_semifunctor'[slicing_intros]:
   assumes "\<AA>' = cat_smc \<AA>" "\<BB>' = cat_smc \<BB>"
   shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule iso_cf_is_iso_semifunctor)
 
 lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_iso_functor) is_iso_functor_axioms'[cf_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_functor_axioms)
 
 mk_ide rf is_iso_functor_def[unfolded is_iso_functor_axioms_def]
   |intro is_iso_functorI|
   |dest is_iso_functorD[dest]|
   |elim is_iso_functorE[elim]|
 
 lemma is_iso_functorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_iso_functorI)
     (
       simp_all add: 
         assms(1) 
         is_iso_semifunctorI'[
           OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_iso_functorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   by 
     (
       simp_all add: 
         is_iso_functorD[OF assms(1)] 
         is_iso_semifunctorD'(2-5)[
           OF is_iso_functorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_iso_functorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   using assms by (simp_all add: is_iso_functorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_iso_functor
 begin
 
 interpretation smcf: is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
   by (rule iso_cf_is_iso_semifunctor) 
 
 lemmas_with [unfolded slicing_simps]:
   iso_cf_ObjMap_vrange[simp] = smcf.iso_smcf_ObjMap_vrange
   and iso_cf_ArrMap_vrange[simp] = smcf.iso_smcf_ArrMap_vrange
 
 sublocale ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
   by (rule smcf.ObjMap.v11_axioms[unfolded slicing_simps]) 
     (simp_all add: cat_cs_simps cf_cs_simps)
   
 sublocale ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   by (rule smcf.ArrMap.v11_axioms[unfolded slicing_simps])
     (simp_all add: cat_cs_simps smcf_cs_simps)
 
 lemmas_with [unfolded slicing_simps]:
   iso_cf_Obj_HomDom_if_Obj_HomCod[elim] = 
     smcf.iso_smcf_Obj_HomDom_if_Obj_HomCod
   and iso_cf_Arr_HomDom_if_Arr_HomCod[elim] = 
     smcf.iso_smcf_Arr_HomDom_if_Arr_HomCod
   and iso_cf_ObjMap_eqE[elim] = smcf.iso_smcf_ObjMap_eqE
   and iso_cf_ArrMap_eqE[elim] = smcf.iso_smcf_ArrMap_eqE
 
 end
 
 sublocale is_iso_functor \<subseteq> is_ff_functor 
 proof(intro is_ff_functorI)
   interpret is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
     by (rule iso_cf_is_iso_semifunctor)
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
 qed
 
 lemmas (in is_iso_functor) iso_cf_is_ff_functor = is_ff_functor_axioms
 lemmas [cf_cs_intros] = is_iso_functor.iso_cf_is_ff_functor
 
 
 subsubsection\<open>Opposite isomorphism of categories\<close>
  
 lemma (in is_iso_functor) is_iso_functor_op: 
   "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_cat \<BB>"   
   by (rule is_iso_functorI, unfold slicing_simps slicing_commute[symmetric]) 
    (simp_all add: cat_op_intros smc_op_intros slicing_intros)
 
 lemma (in is_iso_functor) is_iso_functor_op': 
   assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>"
   shows "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_cat \<BB>"   
   unfolding assms by (rule is_iso_functor_op)
 
 lemmas is_iso_functor_op[cat_op_intros] = 
   is_iso_functor.is_iso_functor_op'
 
 
 subsubsection\<open>
 The composition of isomorphisms of categories is an isomorphism of categories
 \<close>
 
 lemma cf_comp_is_iso_functor[cf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_iso_functorI)
   interpret \<FF>: is_iso_functor \<alpha> \<AA> \<BB> \<FF> using assms by auto
   interpret \<GG>: is_iso_functor \<alpha> \<BB> \<CC> \<GG> using assms by auto
   from \<FF>.is_functor_axioms \<GG>.is_functor_axioms show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     by (cs_concl cs_intro: cat_cs_intros)
   show "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
     unfolding slicing_commute[symmetric] 
     by (cs_concl cs_intro: smcf_cs_intros slicing_intros)
 qed
 
 
 
 subsection\<open>Inverse functor\<close>
 
 abbreviation (input) inv_cf :: "V \<Rightarrow> V"
   where "inv_cf \<equiv> inv_dghm"
 
 
 text\<open>Slicing.\<close>
 
 lemma dghm_inv_semifunctor[slicing_commute]: 
   "inv_smcf (cf_smcf \<FF>) = cf_smcf (inv_cf \<FF>)"
   unfolding cf_smcf_def inv_dghm_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 context is_iso_functor
 begin
 
 interpretation smcf: is_iso_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
   by (rule iso_cf_is_iso_semifunctor) 
 
 lemmas_with [unfolded slicing_simps slicing_commute]:
   inv_cf_ObjMap_v11 = smcf.inv_smcf_ObjMap_v11
   and inv_cf_ObjMap_vdomain = smcf.inv_smcf_ObjMap_vdomain
   and inv_cf_ObjMap_app = smcf.inv_smcf_ObjMap_app
   and inv_cf_ObjMap_vrange = smcf.inv_smcf_ObjMap_vrange
   and inv_cf_ArrMap_v11 = smcf.inv_smcf_ArrMap_v11
   and inv_cf_ArrMap_vdomain = smcf.inv_smcf_ArrMap_vdomain
   and inv_cf_ArrMap_app = smcf.inv_smcf_ArrMap_app
   and inv_cf_ArrMap_vrange = smcf.inv_smcf_ArrMap_vrange
   and iso_cf_ObjMap_inv_cf_ObjMap_app =
     smcf.iso_smcf_ObjMap_inv_smcf_ObjMap_app
   and iso_cf_ArrMap_inv_cf_ArrMap_app = 
     smcf.iso_smcf_ArrMap_inv_smcf_ArrMap_app
   and iso_cf_HomDom_is_arr_conv = smcf.iso_smcf_HomDom_is_arr_conv
   and iso_cf_HomCod_is_arr_conv = smcf.iso_smcf_HomCod_is_arr_conv
 
 end
 
 
 
 subsection\<open>An isomorphism of categories is an isomorphism in the category \<open>CAT\<close>\<close>
 
 lemma is_arr_isomorphism_is_iso_functor:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
     and "\<FF> \<circ>\<^sub>C\<^sub>F \<GG> = cf_id \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
   show ?thesis
   proof(rule is_iso_functorI)
     have \<GG>\<FF>\<AA>: "cf_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> = smcf_id (cat_smc \<AA>)"
       by (simp add: assms(3) cf_smcf_cf_id cf_smcf_smcf_comp)
     have \<FF>\<GG>\<BB>: "cf_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> = smcf_id (cat_smc \<BB>)"
       by (simp add: assms(4) cf_smcf_cf_id cf_smcf_smcf_comp)
     from \<FF>.cf_is_semifunctor \<GG>.cf_is_semifunctor \<GG>\<FF>\<AA> \<FF>\<GG>\<BB> show 
       "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<BB>" 
       by (rule is_arr_isomorphism_is_iso_semifunctor)
   qed (auto simp: cat_cs_intros)
 qed
 
 lemma is_iso_functor_is_arr_isomorphism:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows [cf_cs_intros]: "inv_cf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
     and "inv_cf \<FF> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
     and "\<FF> \<circ>\<^sub>C\<^sub>F inv_cf \<FF> = cf_id \<BB>"
 proof-
 
   let ?\<GG> = "inv_cf \<FF>"
 
   interpret is_iso_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
 
   show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
   proof(intro is_iso_functorI is_functorI, unfold inv_dghm_components)
     show "vfsequence ?\<GG>" by (simp add: inv_dghm_def)
     show "vcard ?\<GG> = 4\<^sub>\<nat>"
       unfolding inv_dghm_def by (simp add: nat_omega_simps)
     show "cf_smcf ?\<GG> : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
       by 
         (
           metis 
             dghm_inv_semifunctor 
             iso_cf_is_iso_semifunctor 
             is_iso_semifunctor_def 
             is_iso_semifunctor_is_arr_isomorphism(1)
         ) 
     show "cf_smcf ?\<GG> : cat_smc \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
       by 
         (
           metis 
             dghm_inv_semifunctor 
             iso_cf_is_iso_semifunctor 
             is_iso_semifunctor_is_arr_isomorphism(1)
         )
     fix c assume prems: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     from prems show "(\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>(\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>\<lparr>c\<rparr>\<rparr>"
       by (intro v11.v11_vconverse_app)
         (
            cs_concl 
             cs_intro: cat_cs_intros V_cs_intros
             cs_simp: V_cs_simps cat_cs_simps
          )+
   qed (simp_all add: cat_cs_simps cat_cs_intros)
 
   show "?\<GG> \<circ>\<^sub>C\<^sub>F \<FF> = cf_id \<AA>"
   proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
     from \<GG> is_functor_axioms show "?\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" 
       by (blast intro: cat_cs_intros)
   qed 
     (
       simp_all add: 
         HomDom.cat_cf_id_is_functor
         ObjMap.v11_vcomp_vconverse 
         ArrMap.v11_vcomp_vconverse 
         dghm_id_components
     )
 
   show "\<FF> \<circ>\<^sub>C\<^sub>F ?\<GG> = cf_id \<BB>"
   proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
     from \<GG> is_functor_axioms show "\<FF> \<circ>\<^sub>C\<^sub>F ?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
       by (blast intro: cat_cs_intros)
     show "cf_id \<BB> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (simp add: HomCod.cat_cf_id_is_functor)
   qed 
     (
       simp_all add:
         ObjMap.v11_vcomp_vconverse' 
         ArrMap.v11_vcomp_vconverse' 
         dghm_id_components
     )
 
 qed
 
 
 subsubsection\<open>An identity functor is an isomorphism of categories\<close>
 
 lemma (in category) cat_cf_id_is_iso_functor: "cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
   by (rule is_iso_functorI, unfold slicing_commute[symmetric])
     (
       simp_all add: 
         cat_cf_id_is_functor
         semicategory.smc_smcf_id_is_iso_semifunctor
         cat_semicategory
     )
 
 
 
 subsection\<open>Isomorphic categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale iso_category = L: category \<alpha> \<AA> + R: category \<alpha> \<BB> for \<alpha> \<AA> \<BB> +
   assumes iso_cat_is_iso_functor: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 
 notation iso_category (infixl "\<approx>\<^sub>C\<index>" 50)
 
 
 text\<open>Rules.\<close>
 
 lemma iso_categoryI:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms unfolding iso_category_def iso_category_axioms_def by auto
 
 lemma iso_categoryD[dest]:
   assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   using assms unfolding iso_category_def iso_category_axioms_def by simp_all
 
 lemma iso_categoryE[elim]:
   assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms by auto
 
 
 text\<open>Isomorphic categories are isomorphic semicategories.\<close>
 
 lemma (in iso_category) iso_cat_iso_semicategory: 
   "cat_smc \<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
   using iso_cat_is_iso_functor 
   by (auto intro: slicing_intros iso_semicategoryI)
 
 
 subsubsection\<open>A category isomorphism is an equivalence relation\<close>
 
 lemma iso_category_refl: 
   assumes "category \<alpha> \<AA>" 
   shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof(rule iso_categoryI[of _ _ _ \<open>cf_id \<AA>\<close>])
   interpret category \<alpha> \<AA> by (rule assms)
   show "cf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" by (simp add: cat_cf_id_is_iso_functor)
 qed                                        
 
 lemma iso_category_sym[sym]:
   assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<BB> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   interpret iso_category \<alpha> \<AA> \<BB> by (rule assms)
   from iso_cat_is_iso_functor obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
   from is_iso_functor_is_arr_isomorphism(1)[OF this] show ?thesis 
     by (auto intro: iso_categoryI)
 qed
 
 lemma iso_category_trans[trans]:
   assumes "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<AA> \<approx>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: iso_category \<alpha> \<AA> \<BB> by (rule assms(1))
   interpret R: iso_category \<alpha> \<BB> \<CC> by (rule assms(2))
   from L.iso_cat_is_iso_functor R.iso_cat_is_iso_functor show ?thesis 
     by (auto intro: iso_categoryI is_iso_functorI cf_comp_is_iso_functor)
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_NTCF.thy
@@ -1,2364 +1,2390 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Natural transformation\<close>
 theory CZH_ECAT_NTCF
   imports 
     CZH_Foundations.CZH_SMC_NTSMCF
     CZH_ECAT_Functor
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems ntcf_cs_simps
 named_theorems ntcf_cs_intros
 
 lemmas [cat_cs_simps] = dg_shared_cs_simps
 lemmas [cat_cs_intros] = dg_shared_cs_intros
 
 
 subsubsection\<open>Slicing\<close>
 
 definition ntcf_ntsmcf :: "V \<Rightarrow> V"
   where "ntcf_ntsmcf \<NN> =
     [
       \<NN>\<lparr>NTMap\<rparr>,
       cf_smcf (\<NN>\<lparr>NTDom\<rparr>),
       cf_smcf (\<NN>\<lparr>NTCod\<rparr>),
       cat_smc (\<NN>\<lparr>NTDGDom\<rparr>),
       cat_smc (\<NN>\<lparr>NTDGCod\<rparr>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_ntsmcf_components:
   shows [slicing_simps]: "ntcf_ntsmcf \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
     and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDom\<rparr> = cf_smcf (\<NN>\<lparr>NTDom\<rparr>)"
     and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTCod\<rparr> = cf_smcf (\<NN>\<lparr>NTCod\<rparr>)"
     and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDGDom\<rparr> = cat_smc (\<NN>\<lparr>NTDGDom\<rparr>)"
     and [slicing_commute]: "ntcf_ntsmcf \<NN>\<lparr>NTDGCod\<rparr> = cat_smc (\<NN>\<lparr>NTDGCod\<rparr>)"
   unfolding ntcf_ntsmcf_def nt_field_simps by (auto simp: nat_omega_simps)
 
 
 
 subsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The definition of a natural transformation that is used in this work is
 is similar to the definition that can be found in Chapter I-4 in 
 \cite{mac_lane_categories_2010}.
 \<close>
 
 locale is_ntcf = 
   \<Z> \<alpha> + 
   vfsequence \<NN> + 
   NTDom: is_functor \<alpha> \<AA> \<BB> \<FF> + 
   NTCod: is_functor \<alpha> \<AA> \<BB> \<GG>
   for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
   assumes ntcf_length[cat_cs_simps]: "vcard \<NN> = 5\<^sub>\<nat>"  
     and ntcf_is_ntsmcf[slicing_intros]: "ntcf_ntsmcf \<NN> :
       cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
     and ntcf_NTDom[cat_cs_simps]: "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
     and ntcf_NTCod[cat_cs_simps]: "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
     and ntcf_NTDGDom[cat_cs_simps]: "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
     and ntcf_NTDGCod[cat_cs_simps]: "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
 
 syntax "_is_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"
 
 abbreviation all_ntcfs :: "V \<Rightarrow> V"
   where "all_ntcfs \<alpha> \<equiv> set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 abbreviation ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcfs \<alpha> \<AA> \<BB> \<equiv> set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 abbreviation these_ntcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv> set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 lemmas [cat_cs_simps] = 
   is_ntcf.ntcf_length
   is_ntcf.ntcf_NTDom
   is_ntcf.ntcf_NTCod
   is_ntcf.ntcf_NTDGDom
   is_ntcf.ntcf_NTDGCod
 
 lemma (in is_ntcf) ntcf_is_ntsmcf':
   assumes "\<FF>' = cf_smcf \<FF>"
     and "\<GG>' = cf_smcf \<GG>"
     and "\<AA>' = cat_smc \<AA>"
     and "\<BB>' = cat_smc \<BB>"
   shows "ntcf_ntsmcf \<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms(1-4) by (rule ntcf_is_ntsmcf)
 
 lemmas [slicing_intros] = is_ntcf.ntcf_is_ntsmcf'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_ntcf) is_ntcf_axioms'[cat_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
   shows "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_ntcf_axioms)
 
 mk_ide rf is_ntcf_def[unfolded is_ntcf_axioms_def]
   |intro is_ntcfI|
   |dest is_ntcfD[dest]|
   |elim is_ntcfE[elim]|
 
 lemmas [cat_cs_intros] = 
   is_ntcfD(3,4)
 
 lemma is_ntcfI':
   assumes "\<Z> \<alpha>"
     and "vfsequence \<NN>"
     and "vcard \<NN> = 5\<^sub>\<nat>"
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
     and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
     and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
     and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
     and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
   shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   by (intro is_ntcfI is_ntsmcfI', unfold ntcf_ntsmcf_components slicing_simps)
     (
       simp_all add: 
         assms nat_omega_simps 
         ntcf_ntsmcf_def  
         is_functorD(6)[OF assms(4)] 
         is_functorD(6)[OF assms(5)]
     )
 
 lemma is_ntcfD':
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<Z> \<alpha>"
     and "vfsequence \<NN>"
     and "vcard \<NN> = 5\<^sub>\<nat>"
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
     and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
     and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
     and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
     and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
   by 
     (
       simp_all add: 
         is_ntcfD(2-10)[OF assms] 
         is_ntsmcfD'[OF is_ntcfD(6)[OF assms], unfolded slicing_simps]
     )
 
 lemma is_ntcfE':
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<Z> \<alpha>"
     and "vfsequence \<NN>"
     and "vcard \<NN> = 5\<^sub>\<nat>"
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN>\<lparr>NTDom\<rparr> = \<FF>"
     and "\<NN>\<lparr>NTCod\<rparr> = \<GG>"
     and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
     and "\<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
     and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
   using assms by (simp add: is_ntcfD')
 
 
 text\<open>Slicing.\<close>
 
 context is_ntcf
 begin
 
 interpretation ntsmcf: 
   is_ntsmcf \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close> \<open>cf_smcf \<GG>\<close> \<open>ntcf_ntsmcf \<NN>\<close>
   by (rule ntcf_is_ntsmcf)
 
 lemmas_with [unfolded slicing_simps]:
   ntcf_NTMap_vsv = ntsmcf.ntsmcf_NTMap_vsv
   and ntcf_NTMap_vdomain[cat_cs_simps] = ntsmcf.ntsmcf_NTMap_vdomain
   and ntcf_NTMap_is_arr = ntsmcf.ntsmcf_NTMap_is_arr
   and ntcf_NTMap_is_arr'[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_is_arr'
 
 sublocale NTMap: vsv \<open>\<NN>\<lparr>NTMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   by (rule ntcf_NTMap_vsv) (simp add: cat_cs_simps)
 
 lemmas_with [unfolded slicing_simps]:
   ntcf_NTMap_app_in_Arr[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_app_in_Arr
   and ntcf_NTMap_vrange_vifunion = ntsmcf.ntsmcf_NTMap_vrange_vifunion
   and ntcf_NTMap_vrange = ntsmcf.ntsmcf_NTMap_vrange
   and ntcf_NTMap_vsubset_Vset = ntsmcf.ntsmcf_NTMap_vsubset_Vset
   and ntcf_NTMap_in_Vset = ntsmcf.ntsmcf_NTMap_in_Vset
   and ntcf_is_ntsmcf_if_ge_Limit = ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit
 
 lemmas_with [unfolded slicing_simps]:
   ntcf_Comp_commute[cat_cs_intros] = ntsmcf.ntsmcf_Comp_commute
   and ntcf_Comp_commute' = ntsmcf.ntsmcf_Comp_commute'
   and ntcf_Comp_commute'' = ntsmcf.ntsmcf_Comp_commute''
 
 end
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_NTMap_vdomain
 
 lemmas [cat_cs_intros] = 
   is_ntcf.ntcf_NTMap_is_arr'
   ntsmcf_hcomp_NTMap_vsv
 
 
 text\<open>Elementary properties.\<close>
 
 lemma ntcf_eqI:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
     and "\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>"
     and "\<FF> = \<FF>'"
     and "\<GG> = \<GG>'"
     and "\<AA> = \<AA>'"
     and "\<BB> = \<BB>'"
   shows "\<NN> = \<NN>'"
 proof-
   interpret L: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret R: is_ntcf \<alpha> \<AA>' \<BB>' \<FF>' \<GG>' \<NN>' by (rule assms(2))
   show ?thesis
   proof(rule vsv_eqI)
     have dom: "\<D>\<^sub>\<circ> \<NN> = 5\<^sub>\<nat>" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
     show "\<D>\<^sub>\<circ> \<NN> = \<D>\<^sub>\<circ> \<NN>'" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
     from assms(4-7) have sup: 
       "\<NN>\<lparr>NTDom\<rparr> = \<NN>'\<lparr>NTDom\<rparr>" "\<NN>\<lparr>NTCod\<rparr> = \<NN>'\<lparr>NTCod\<rparr>" 
       "\<NN>\<lparr>NTDGDom\<rparr> = \<NN>'\<lparr>NTDGDom\<rparr>" "\<NN>\<lparr>NTDGCod\<rparr> = \<NN>'\<lparr>NTDGCod\<rparr>" 
       by (simp_all add: cat_cs_simps)
     show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<NN> \<Longrightarrow> \<NN>\<lparr>a\<rparr> = \<NN>'\<lparr>a\<rparr>" for a
       by (unfold dom, elim_in_numeral, insert assms(3) sup) 
         (auto simp: nt_field_simps)
   qed auto
 qed
 
 lemma ntcf_ntsmcf_eqI:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
     and "\<FF> = \<FF>'"
     and "\<GG> = \<GG>'"
     and "\<AA> = \<AA>'"
     and "\<BB> = \<BB>'"
     and "ntcf_ntsmcf \<NN> = ntcf_ntsmcf \<NN>'"
   shows "\<NN> = \<NN>'"
 proof(rule ntcf_eqI[of \<alpha>])
   from assms(7) have "ntcf_ntsmcf \<NN>\<lparr>NTMap\<rparr> = ntcf_ntsmcf \<NN>'\<lparr>NTMap\<rparr>" by simp
   then show "\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>" unfolding slicing_simps by simp_all
   from assms(3-6) show "\<FF> = \<FF>'" "\<GG> = \<GG>'" "\<AA> = \<AA>'" "\<BB> = \<BB>'" by simp_all
 qed (auto simp: assms(1,2))
 
 lemma (in is_ntcf) ntcf_def:
   "\<NN> = [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> \<NN> = 5\<^sub>\<nat>" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
   have dom_rhs:
     "\<D>\<^sub>\<circ> [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>]\<^sub>\<circ> = 5\<^sub>\<nat>"
     by (simp add: nat_omega_simps)
   then show 
     "\<D>\<^sub>\<circ> \<NN> = \<D>\<^sub>\<circ> [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>"
     unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<NN> \<Longrightarrow>
     \<NN>\<lparr>a\<rparr> = [\<NN>\<lparr>NTMap\<rparr>, \<NN>\<lparr>NTDom\<rparr>, \<NN>\<lparr>NTCod\<rparr>, \<NN>\<lparr>NTDGDom\<rparr>, \<NN>\<lparr>NTDGCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" 
     for a
     by (unfold dom_lhs, elim_in_numeral, unfold nt_field_simps)
       (simp_all add: nat_omega_simps)
 qed (auto simp: vsv_axioms)
 
 lemma (in is_ntcf) ntcf_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"  
   shows "\<NN> \<in>\<^sub>\<circ> Vset \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   note [cat_cs_intros] = 
     ntcf_NTMap_in_Vset
     NTDom.cf_in_Vset
     NTCod.cf_in_Vset
     NTDom.HomDom.cat_in_Vset
     NTDom.HomCod.cat_in_Vset
   from assms(2) show ?thesis
     by (subst ntcf_def) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
 qed
 
 lemma (in is_ntcf) ntcf_is_ntcf_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
 proof(intro is_ntcfI)
   show "ntcf_ntsmcf \<NN> :
     cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<GG> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> cat_smc \<BB>"
     by (rule is_ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit[OF ntcf_is_ntsmcf assms])
 qed 
   (
     cs_concl 
       cs_simp: cat_cs_simps 
       cs_intro:
         V_cs_intros
         assms 
         NTDom.cf_is_functor_if_ge_Limit
         NTCod.cf_is_functor_if_ge_Limit
    )+
 
 lemma small_all_ntcfs[simp]:
   "small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 proof(cases \<open>\<Z> \<alpha>\<close>)
   case True
   from is_ntcf.ntcf_in_Vset show ?thesis
     by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>])
       (auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
 next
   case False
   then have "{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
   then show ?thesis by simp
 qed
 
 lemma small_ntcfs[simp]: "small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
   by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto
 
 lemma small_these_ntcfs[simp]: "small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
   by (rule down[of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto
 
 
 text\<open>Further elementary results.\<close>
 
 lemma these_ntcfs_iff: (*not simp*) 
   "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   by auto
 
 
 
 subsection\<open>Opposite natural transformation\<close>
 
 
 text\<open>See section 1.5 in \cite{bodo_categories_1970}.\<close>
 
 definition op_ntcf :: "V \<Rightarrow> V"
   where "op_ntcf \<NN> = 
     [
       \<NN>\<lparr>NTMap\<rparr>, 
       op_cf (\<NN>\<lparr>NTCod\<rparr>), 
       op_cf (\<NN>\<lparr>NTDom\<rparr>), 
       op_cat (\<NN>\<lparr>NTDGDom\<rparr>), 
       op_cat (\<NN>\<lparr>NTDGCod\<rparr>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma op_ntcf_components[cat_op_simps]:
   shows "op_ntcf \<NN>\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
     and "op_ntcf \<NN>\<lparr>NTDom\<rparr> = op_cf (\<NN>\<lparr>NTCod\<rparr>)"
     and "op_ntcf \<NN>\<lparr>NTCod\<rparr> = op_cf (\<NN>\<lparr>NTDom\<rparr>)"
     and "op_ntcf \<NN>\<lparr>NTDGDom\<rparr> = op_cat (\<NN>\<lparr>NTDGDom\<rparr>)"
     and "op_ntcf \<NN>\<lparr>NTDGCod\<rparr> = op_cat (\<NN>\<lparr>NTDGCod\<rparr>)"
   unfolding op_ntcf_def nt_field_simps by (auto simp: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma ntcf_ntsmcf_op_ntcf[slicing_commute]: 
   "op_ntsmcf (ntcf_ntsmcf \<NN>) = ntcf_ntsmcf (op_ntcf \<NN>)"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) = 5\<^sub>\<nat>"
     unfolding op_ntsmcf_def by (auto simp: nat_omega_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_ntsmcf (op_ntcf \<NN>)) = 5\<^sub>\<nat>"
     unfolding ntcf_ntsmcf_def by (auto simp: nat_omega_simps)
   show "\<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) = \<D>\<^sub>\<circ> (ntcf_ntsmcf (op_ntcf \<NN>))"
     unfolding dom_lhs dom_rhs by simp
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_ntsmcf (ntcf_ntsmcf \<NN>)) \<Longrightarrow> 
     op_ntsmcf (ntcf_ntsmcf \<NN>)\<lparr>a\<rparr> = ntcf_ntsmcf (op_ntcf \<NN>)\<lparr>a\<rparr>"
     for a
     by 
       (
         unfold dom_lhs,
         elim_in_numeral,
         unfold nt_field_simps ntcf_ntsmcf_def op_ntcf_def op_ntsmcf_def
       )
       (auto simp: nat_omega_simps slicing_commute[symmetric])
 qed (auto simp: ntcf_ntsmcf_def op_ntsmcf_def)
 
 
 text\<open>Elementary properties.\<close>
 
 lemma op_ntcf_vsv[cat_op_intros]: "vsv (op_ntcf \<FF>)" 
   unfolding op_ntcf_def by auto
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_ntcf) is_ntcf_op: 
   "op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
 proof(rule is_ntcfI, unfold cat_op_simps)
   show "vfsequence (op_ntcf \<NN>)" by (simp add: op_ntcf_def)
   show "vcard (op_ntcf \<NN>) = 5\<^sub>\<nat>" by (simp add: op_ntcf_def nat_omega_simps)
 qed
   (
     use is_ntcf_axioms in
     \<open>
       cs_concl 
         cs_simp: cat_cs_simps slicing_commute[symmetric]
         cs_intro: cat_cs_intros cat_op_intros smc_op_intros slicing_intros
     \<close>
   )+
 
 lemma (in is_ntcf) is_ntcf_op'[cat_op_intros]:
   assumes "\<GG>' = op_cf \<GG>"
     and "\<FF>' = op_cf \<FF>"
     and "\<AA>' = op_cat \<AA>"
     and "\<BB>' = op_cat \<BB>"
   shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_ntcf_op)
 
 lemmas [cat_op_intros] = is_ntcf.is_ntcf_op'
 
 lemma (in is_ntcf) ntcf_op_ntcf_op_ntcf[cat_op_simps]: 
   "op_ntcf (op_ntcf \<NN>) = \<NN>"
 proof(rule ntcf_eqI[of \<alpha> \<AA> \<BB> \<FF> \<GG> _ \<AA> \<BB> \<FF> \<GG>], unfold cat_op_simps)
   interpret op: 
     is_ntcf \<alpha> \<open>op_cat \<AA>\<close> \<open>op_cat \<BB>\<close> \<open>op_cf \<GG>\<close> \<open>op_cf \<FF>\<close> \<open>op_ntcf \<NN>\<close>
     by (rule is_ntcf_op)
   from op.is_ntcf_op show 
     "op_ntcf (op_ntcf \<NN>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (simp add: cat_op_simps)
 qed (auto simp: cat_cs_intros)
 
 lemmas ntcf_op_ntcf_op_ntcf[cat_op_simps] = 
   is_ntcf.ntcf_op_ntcf_op_ntcf
 
 lemma eq_op_ntcf_iff[cat_op_simps]: 
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   shows "op_ntcf \<NN> = op_ntcf \<NN>' \<longleftrightarrow> \<NN> = \<NN>'"
 proof
   interpret L: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret R: is_ntcf \<alpha> \<AA>' \<BB>' \<FF>' \<GG>' \<NN>' by (rule assms(2))
   assume prems: "op_ntcf \<NN> = op_ntcf \<NN>'"
   show "\<NN> = \<NN>'"
   proof(rule ntcf_eqI[OF assms])
     from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf show 
       "\<NN>\<lparr>NTMap\<rparr> = \<NN>'\<lparr>NTMap\<rparr>"
       by metis+
     from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf 
     have "\<NN>\<lparr>NTDom\<rparr> = \<NN>'\<lparr>NTDom\<rparr>" 
       and "\<NN>\<lparr>NTCod\<rparr> = \<NN>'\<lparr>NTCod\<rparr>" 
       and "\<NN>\<lparr>NTDGDom\<rparr> = \<NN>'\<lparr>NTDGDom\<rparr>" 
       and "\<NN>\<lparr>NTDGCod\<rparr> = \<NN>'\<lparr>NTDGCod\<rparr>" 
       by metis+
     then show "\<FF> = \<FF>'" "\<GG> = \<GG>'" "\<AA> = \<AA>'" "\<BB> = \<BB>'" 
       by (auto simp: cat_cs_simps)
   qed
 qed auto
 
 
 
 subsection\<open>Vertical composition of natural transformations\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation (input) ntcf_vcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close> 55)
   where "ntcf_vcomp \<equiv> ntsmcf_vcomp"
 
 lemmas [cat_cs_simps] = ntsmcf_vcomp_components(2-5)
 
 
 text\<open>Slicing.\<close>
 
 lemma ntcf_ntsmcf_ntcf_vcomp[slicing_commute]: 
   "ntcf_ntsmcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
   unfolding 
     ntsmcf_vcomp_def ntcf_ntsmcf_def cat_smc_def nt_field_simps dg_field_simps 
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma ntcf_vcomp_NTMap_vdomain[cat_cs_simps]:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by auto
   show ?thesis
     by 
       (
         rule ntsmcf_vcomp_NTMap_vdomain
           [
             OF \<NN>.ntcf_is_ntsmcf, 
             of \<open>ntcf_ntsmcf \<MM>\<close>,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma ntcf_vcomp_NTMap_app[cat_cs_simps]:
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
   shows "(\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms by clarsimp
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by clarsimp
   show ?thesis
     by 
       (
         rule ntsmcf_vcomp_NTMap_app
           [
             OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 lemma ntcf_vcomp_NTMap_vrange:
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms by auto
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms by auto
   show ?thesis
     by 
       (
         rule 
           ntsmcf_vcomp_NTMap_vrange[
             OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma ntcf_vcomp_composable_commute[cat_cs_simps]:
   \<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and [intro]: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
   shows 
     "(\<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = 
       \<HH>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1)) 
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
     by 
       (
         rule ntsmcf_vcomp_composable_commute[
             OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
             unfolded slicing_simps,
             OF assms(3)
           ]
       )
 qed 
 
 lemma ntcf_vcomp_is_ntcf[cat_cs_intros]:
   \<comment>\<open>see Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis 
   proof(intro is_ntcfI)
     show "vfsequence (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" by (simp add: ntsmcf_vcomp_def)
     show "vcard (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
       unfolding ntsmcf_vcomp_def by (simp add: nat_omega_simps)
     show "ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) : 
       cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<HH> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
       by 
         (
           rule ntsmcf_vcomp_is_ntsmcf[
             OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
             unfolded slicing_simps slicing_commute
             ]
         )
   qed (auto simp: ntsmcf_vcomp_components(1) cat_cs_simps cat_cs_intros)
 qed
 
 lemma ntcf_vcomp_assoc[cat_cs_simps]:
   \<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<LL> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof-
   interpret \<LL>: is_ntcf \<alpha> \<AA> \<BB> \<HH> \<KK> \<LL> by (rule assms(1))
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
   show ?thesis
   proof(rule ntcf_eqI[of \<alpha>])
     from ntsmcf_vcomp_assoc[
         OF \<LL>.ntcf_is_ntsmcf \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
         unfolded slicing_simps slicing_commute
       ]
     have 
       "ntcf_ntsmcf (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> =
         ntcf_ntsmcf (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       by simp
     then show "(\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = (\<LL> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       unfolding slicing_simps .
   qed (auto intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>
 The opposite of the vertical composition of natural transformations
 \<close>
 
 lemma op_ntcf_ntcf_vcomp[cat_op_simps]: 
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> using assms(1) by auto
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> using assms(2) by auto
   show ?thesis
   proof(rule sym, rule ntcf_eqI[of \<alpha>])
     from 
       op_ntsmcf_ntsmcf_vcomp
         [
           OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
           unfolded slicing_simps slicing_commute
         ]
     have "ntcf_ntsmcf (op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>)\<lparr>NTMap\<rparr> = 
       ntcf_ntsmcf (op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       by simp
     then show "(op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<MM>)\<lparr>NTMap\<rparr> = op_ntcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>"
       unfolding slicing_simps .
   qed (auto intro: cat_cs_intros cat_op_intros)
 qed
 
 
 
 subsection\<open>Horizontal composition of natural transformations\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation (input) ntcf_hcomp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close> 55)
   where "ntcf_hcomp \<equiv> ntsmcf_hcomp"
 
 lemmas [cat_cs_simps] = ntsmcf_hcomp_components(2-5)
 
 
 text\<open>Slicing.\<close>
 
 lemma ntcf_ntsmcf_ntcf_hcomp[slicing_commute]: 
   "ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof(rule vsv_eqI)
   show "vsv (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)"
     unfolding ntsmcf_hcomp_def by auto
   show "vsv (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))" unfolding ntcf_ntsmcf_def by auto
   have dom_lhs: 
     "\<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>) = 5\<^sub>\<nat>" 
     unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) = 5\<^sub>\<nat>"
     unfolding ntcf_ntsmcf_def by (simp add: nat_omega_simps)
   show "\<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>) = 
     \<D>\<^sub>\<circ> (ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))"
     unfolding dom_lhs dom_rhs ..
   fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)"
   then show 
     "(ntcf_ntsmcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)\<lparr>a\<rparr> = ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>a\<rparr>"
     unfolding dom_lhs
     by (elim_in_numeral; fold nt_field_simps) 
       (simp_all add: ntsmcf_hcomp_components slicing_simps slicing_commute)
 qed
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma ntcf_hcomp_NTMap_vdomain[cat_cs_simps]: 
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
   show ?thesis unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
 qed
 
 lemma ntcf_hcomp_NTMap_app[cat_cs_simps]:
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
   shows "(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
     \<GG>'\<lparr>ArrMap\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   from assms(3) show ?thesis 
     unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
 qed
 
 lemma ntcf_hcomp_NTMap_vrange:
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
     by 
       (
         rule ntsmcf_hcomp_NTMap_vrange[
           OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
           unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma ntcf_hcomp_composable_commute:
   \<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" 
   shows 
     "(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = 
       (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
     (is \<open>?\<MM>\<NN>b \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>'\<FF>f = ?\<GG>'\<GG>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<MM>\<NN>a\<close>)
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
     by 
       (
         rule ntsmcf_hcomp_composable_commute[
           OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
           unfolded slicing_simps slicing_commute, 
           OF assms(3)
           ]
       )
 qed
 
 lemma ntcf_hcomp_is_ntcf:
   \<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
   proof(intro is_ntcfI) 
     show "vfsequence (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
       unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
     show "vcard (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
       unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
     show "ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) : 
       cf_smcf (\<FF>' \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>) : 
       cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       by 
         (
           rule ntsmcf_hcomp_is_ntsmcf[
             OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
             unfolded slicing_simps slicing_commute
             ]
         )
   qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps intro: cat_cs_intros)
 qed
 
 lemma ntcf_hcomp_is_ntcf'[cat_cs_intros]:
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<SS> = \<FF>' \<circ>\<^sub>C\<^sub>F \<FF>"
     and "\<SS>' = \<GG>' \<circ>\<^sub>C\<^sub>F \<GG>"
   shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_ntcf)
 
 lemma ntcf_hcomp_associativ[cat_cs_simps]: 
   assumes "\<LL> : \<FF>'' \<mapsto>\<^sub>C\<^sub>F \<GG>'' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof-
   interpret \<LL>: is_ntcf \<alpha> \<CC> \<DD> \<FF>'' \<GG>'' \<LL> by (rule assms(1))
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
   show ?thesis
   proof(rule ntcf_eqI[of \<alpha>])
     show "\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) : 
       \<FF>'' \<circ>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>'' \<circ>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from ntsmcf_hcomp_assoc[
       OF \<LL>.ntcf_is_ntsmcf \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf,
       unfolded slicing_commute
       ]
     have 
       "ntcf_ntsmcf (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = 
         ntcf_ntsmcf (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       by simp
     then show "(\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = (\<LL> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       unfolding slicing_simps .
   qed (auto intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>
 The opposite of the horizontal composition of natural transformations
 \<close>
 
 lemma op_ntcf_ntcf_hcomp[cat_op_simps]: 
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
   proof(rule sym, rule ntcf_eqI[of \<alpha>])
     from op_ntsmcf_ntsmcf_hcomp[
         OF \<MM>.ntcf_is_ntsmcf \<NN>.ntcf_is_ntsmcf, 
         unfolded slicing_simps slicing_commute 
         ]
     have "ntcf_ntsmcf (op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>)\<lparr>NTMap\<rparr> =
       ntcf_ntsmcf (op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       by simp
     then show "(op_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>)\<lparr>NTMap\<rparr> = op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>"
       unfolding slicing_simps .
     have "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (rule ntcf_hcomp_is_ntcf[OF assms])
     from is_ntcf.is_ntcf_op[OF this] show 
       "op_ntcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) : 
         op_cf \<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF>' \<circ>\<^sub>C\<^sub>F op_cf \<FF> : 
         op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
       unfolding cat_op_simps .
   qed (auto intro: cat_op_intros cat_cs_intros)
 qed 
 
 
 
 subsection\<open>Interchange law\<close>
 
 lemma ntcf_comp_interchange_law:
   \<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<MM>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN>' : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "((\<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>') \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) = (\<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof-
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   interpret \<MM>': is_ntcf \<alpha> \<BB> \<CC> \<GG>' \<HH>' \<MM>' by (rule assms(3))
   interpret \<NN>': is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<NN>' by (rule assms(4))
   show ?thesis
   proof(rule ntcf_eqI)
     from ntsmcf_comp_interchange_law
       [
         OF 
           \<MM>.ntcf_is_ntsmcf 
           \<NN>.ntcf_is_ntsmcf 
           \<MM>'.ntcf_is_ntsmcf 
           \<NN>'.ntcf_is_ntsmcf
       ]
     have 
       "(
         (ntcf_ntsmcf \<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>') \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F
         (ntcf_ntsmcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)
        )\<lparr>NTMap\<rparr> =
         (
           (ntcf_ntsmcf \<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
           (ntcf_ntsmcf \<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN>)
         )\<lparr>NTMap\<rparr>"
       by simp
     then show 
       "(\<MM>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr> =
         (\<MM>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))\<lparr>NTMap\<rparr>"
       unfolding slicing_simps slicing_commute .
   qed (auto intro: cat_cs_intros)
 qed
 
 
 
 subsection\<open>Identity natural transformation\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
 
 definition ntcf_id :: "V \<Rightarrow> V"
   where "ntcf_id \<FF> = [\<FF>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>, \<FF>, \<FF>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_id_components:
   shows "ntcf_id \<FF>\<lparr>NTMap\<rparr> = \<FF>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDom\<rparr> = \<FF>" 
     and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTCod\<rparr> = \<FF>" 
     and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDGDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" 
     and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id \<FF>\<lparr>NTDGCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>" 
   unfolding ntcf_id_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 lemma (in is_functor) is_functor_ntcf_id_components:
   shows "ntcf_id \<FF>\<lparr>NTMap\<rparr> = \<BB>\<lparr>CId\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and "ntcf_id \<FF>\<lparr>NTDom\<rparr> = \<FF>" 
     and "ntcf_id \<FF>\<lparr>NTCod\<rparr> = \<FF>" 
     and "ntcf_id \<FF>\<lparr>NTDGDom\<rparr> = \<AA>" 
     and "ntcf_id \<FF>\<lparr>NTDGCod\<rparr> = \<BB>" 
   unfolding ntcf_id_components by (simp_all add: cat_cs_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma (in is_functor) ntcf_id_NTMap_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   using cf_ObjMap_vrange unfolding is_functor_ntcf_id_components 
   by (auto simp: cat_cs_simps)
 
 lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_vdomain
 
 lemma (in is_functor) ntcf_id_NTMap_app_vdomain[cat_cs_simps]: 
   assumes [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
   unfolding is_functor_ntcf_id_components
   by (rule vsv_vcomp_at) (auto simp: cf_ObjMap_vrange cat_cs_simps cat_cs_intros)
 
 lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_app_vdomain
 
 lemma (in is_functor) ntcf_id_NTMap_vsv[cat_cs_intros]: 
   "vsv (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
   unfolding is_functor_ntcf_id_components by (auto intro: vsv_vcomp)
 
 lemmas [cat_cs_intros] = is_functor.ntcf_id_NTMap_vsv
 
 lemma (in is_functor) ntcf_id_NTMap_vrange: 
   "\<R>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
 proof(rule vsubsetI)
   interpret vsv \<open>ntcf_id \<FF>\<lparr>NTMap\<rparr>\<close> by (rule ntcf_id_NTMap_vsv)
   fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
   then obtain a 
     where f_def: "f = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" and a: "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)"
     using vrange_atD by metis
   then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "f = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
     by (auto simp: cat_cs_simps)
   then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
     by (auto dest: cf_ObjMap_app_in_HomCod_Obj HomCod.cat_CId_is_arr)
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_functor) cf_ntcf_id_is_ntcf[cat_cs_intros]: 
   "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof(rule is_ntcfI, unfold is_functor_ntcf_id_components(2,3,4,5))
   show "ntcf_ntsmcf (ntcf_id \<FF>) : 
     cf_smcf \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
   proof
     (
       rule is_ntsmcfI, 
       unfold slicing_simps slicing_commute is_functor_ntcf_id_components(2,3,4,5)
     )
     show "ntsmcf_tdghm (ntcf_ntsmcf (ntcf_id \<FF>)) : 
       smcf_dghm (cf_smcf \<FF>) \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm (cf_smcf \<FF>) : 
       smc_dg (cat_smc \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg (cat_smc \<BB>)"
       by
         (
           rule is_tdghmI, 
           unfold 
             slicing_simps 
             slicing_commute 
             is_functor_ntcf_id_components(2,3,4,5)
         )
         (
           auto 
             simp:
               cat_cs_simps
               cat_cs_intros
               nat_omega_simps
               ntsmcf_tdghm_def
               cf_is_semifunctor 
             intro: slicing_intros
         )
     fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     with is_functor_axioms show "ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = 
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: ntcf_ntsmcf_def nat_omega_simps intro: slicing_intros)
 qed (auto simp: ntcf_id_def nat_omega_simps intro: cat_cs_intros)
 
 lemma (in is_functor) cf_ntcf_id_is_ntcf': 
   assumes "\<GG>' = \<FF>" and "\<HH>' = \<FF>"
   shows "ntcf_id \<FF> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   unfolding assms by (rule cf_ntcf_id_is_ntcf)
 
 lemmas [cat_cs_intros] = is_functor.cf_ntcf_id_is_ntcf'
 
 lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_left_left[cat_cs_simps]:
   \<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
   "ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
 proof(rule ntcf_eqI[of \<alpha>])
   interpret id: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<GG> \<open>ntcf_id \<GG>\<close> 
     by (rule NTCod.cf_ntcf_id_is_ntcf)
   show "(ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI)
     show [simp]: "\<D>\<^sub>\<circ> ((ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
       unfolding ntsmcf_vcomp_components 
       by (simp add: cat_cs_simps)
     fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"
     then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
     then show "(ntcf_id \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: ntsmcf_vcomp_components)
 qed (auto intro: cat_cs_intros)
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_left_left
 
 lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_right_left[cat_cs_simps]: 
   \<comment>\<open>See Chapter II-4 in \cite{mac_lane_categories_2010}.\<close>
   "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = \<NN>"
 proof(rule ntcf_eqI[of \<alpha>])
   interpret id: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<FF> \<open>ntcf_id \<FF>\<close>    
     by (rule NTDom.cf_ntcf_id_is_ntcf)
   show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI)
     show [simp]: "\<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
       unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
     fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>)"
     then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
     then show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" 
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: ntsmcf_vcomp_components)
 qed (auto intro: cat_cs_intros)
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_right_left
 
 lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_left_left[cat_cs_simps]:
   \<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
   "ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
 proof(rule ntcf_eqI)
   interpret id: is_ntcf \<alpha> \<BB> \<BB> \<open>cf_id \<BB>\<close> \<open>cf_id \<BB>\<close> \<open>ntcf_id (cf_id \<BB>)\<close> 
     by 
       (
         simp add: 
           NTDom.HomCod.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
       )
   show "ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : 
     cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F cf_id \<BB> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros)
   show "(ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI)
     fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"    
     then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
       unfolding ntcf_hcomp_NTMap_vdomain[OF is_ntcf_axioms] by simp
     with is_ntcf_axioms show 
       "(ntcf_id (cf_id \<BB>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
 qed (auto simp: cat_cs_simps intro: cat_cs_intros)
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_left_left
 
 lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_right_left[cat_cs_simps]: 
   \<comment>\<open>See Chapter II-5 in \cite{mac_lane_categories_2010}.\<close>
   "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>) = \<NN>"
 proof(rule ntcf_eqI[of \<alpha>])
   interpret id: is_ntcf \<alpha> \<AA> \<AA> \<open>cf_id \<AA>\<close> \<open>cf_id \<AA>\<close> \<open>ntcf_id (cf_id \<AA>)\<close> 
     by 
       (
         simp add: 
           NTDom.HomDom.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
       )
   show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>) :
     \<FF> \<circ>\<^sub>C\<^sub>F cf_id \<AA> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F cf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros)
   show "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI)
     fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr>)"
     then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
       unfolding ntcf_hcomp_NTMap_vdomain[OF id.is_ntcf_axioms] by simp
     with is_ntcf_axioms show 
       "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<AA>))\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
 qed (auto simp: cat_cs_simps cat_cs_intros)
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_right_left
 
 
 subsubsection\<open>The opposite identity natural transformation\<close>
 
 lemma (in is_functor) cf_ntcf_id_op_cf: "ntcf_id (op_cf \<FF>) = op_ntcf (ntcf_id \<FF>)"
 proof(rule ntcf_eqI)
   show ntcfid_op: 
     "ntcf_id (op_cf \<FF>) : op_cf \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
     by (simp add: is_functor.cf_ntcf_id_is_ntcf local.is_functor_op)
   show "ntcf_id (op_cf \<FF>)\<lparr>NTMap\<rparr> = op_ntcf (ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
     by (rule vsv_eqI, unfold cat_op_simps)
       (
         auto 
           simp: cat_op_simps cat_cs_simps ntcf_id_components(1) 
           intro: vsv_vcomp
       )
 qed (auto intro: cat_op_intros cat_cs_intros)
 
 
 subsubsection\<open>Identity natural transformation of a composition of functors\<close>
 
 lemma ntcf_id_cf_comp:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) = ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
 proof(rule ntcf_eqI)
   from assms show \<GG>\<FF>: "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   interpret \<GG>\<FF>: is_ntcf \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<close>
     by (rule \<GG>\<FF>)
   from assms show \<GG>_\<FF>:
     "ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   interpret \<GG>_\<FF>: is_ntcf \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>\<close>
     by (rule \<GG>_\<FF>)
   show "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold \<GG>\<FF>.ntcf_NTMap_vdomain \<GG>_\<FF>.ntcf_NTMap_vdomain)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "ntcf_id (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed auto
 qed auto
 
 lemmas [cat_cs_simps] = ntcf_id_cf_comp[symmetric]
 
 
 
 subsection\<open>Composition of a natural transformation and a functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 abbreviation (input) ntcf_cf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F" 55)
   where "ntcf_cf_comp \<equiv> tdghm_dghm_comp"
 
 
 text\<open>Slicing.\<close>
 
 lemma ntsmcf_tdghm_ntsmcf_smcf_comp[slicing_commute]: 
   "ntcf_ntsmcf \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf \<HH> = ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)"
   unfolding 
     ntcf_ntsmcf_def
     cf_smcf_def
     cat_smc_def
     tdghm_dghm_comp_def 
     dghm_comp_def 
     ntsmcf_tdghm_def 
     smcf_dghm_def
     smc_dg_def
     dg_field_simps
     dghm_field_simps 
     nt_field_simps 
   by (simp add: nat_omega_simps) (*slow*)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda (in is_functor) 
   tdghm_dghm_comp_components(1)[where \<HH>=\<FF>, unfolded cf_HomDom]
   |vdomain ntcf_cf_comp_NTMap_vdomain[cat_cs_simps]|
   |app ntcf_cf_comp_NTMap_app[cat_cs_simps]|
 
 lemmas [cat_cs_simps] = 
   is_functor.ntcf_cf_comp_NTMap_vdomain
   is_functor.ntcf_cf_comp_NTMap_app
 
 lemma ntcf_cf_comp_NTMap_vrange: 
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
   show ?thesis unfolding tdghm_dghm_comp_components 
     by (auto simp: cat_cs_simps intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>
 Opposite of the composition of a natural transformation and a functor
 \<close>
 
 lemma op_ntcf_ntcf_cf_comp[cat_op_simps]:
   "op_ntcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) = op_ntcf \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<HH>"
   unfolding 
     tdghm_dghm_comp_def 
     dghm_comp_def 
     op_ntcf_def 
     op_cf_def 
     op_cat_def
     dg_field_simps
     dghm_field_simps
     nt_field_simps
   by (simp add: nat_omega_simps) (*slow*)
 
 
 subsubsection\<open>
 Composition of a natural transformation and a
 functor is a natural transformation
 \<close>
 
 lemma ntcf_cf_comp_is_ntcf:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
   show ?thesis
   proof(rule is_ntcfI)
     show "vfsequence (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>)"
       unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
     from assms show "\<FF> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
       by (cs_concl cs_intro: cat_cs_intros)
     from assms show "\<GG> \<circ>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
       by (cs_concl cs_intro: cat_cs_intros)
     show "vcard (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) = 5\<^sub>\<nat>"
       unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
     from assms show 
       "ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH>) :
         cf_smcf (\<FF> \<circ>\<^sub>C\<^sub>F \<HH>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<HH>) :
         cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       by 
         (
           cs_concl 
             cs_simp: slicing_commute[symmetric] 
             cs_intro: slicing_intros smc_cs_intros cat_cs_intros
         )
   qed (auto simp: tdghm_dghm_comp_components(1) cat_cs_simps)
 qed
 
-lemma ntcf_cf_comp_is_functor'[cat_cs_intros]:
+lemma ntcf_cf_comp_is_ntcf'[cat_cs_intros]:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<FF>' = \<FF> \<circ>\<^sub>C\<^sub>F \<HH>"
     and "\<GG>' = \<GG> \<circ>\<^sub>C\<^sub>F \<HH>"
   shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<HH> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1,2) unfolding assms(3,4) by (simp add: ntcf_cf_comp_is_ntcf)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma ntcf_cf_comp_ntcf_cf_comp_assoc:
   assumes "\<NN> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> = \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>)"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<CC> \<DD> \<HH> \<HH>' \<NN> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3))
   show ?thesis  
   proof(rule ntcf_ntsmcf_eqI)
     from assms show
       "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> :
         \<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH>' \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       by (cs_concl cs_intro: cat_cs_intros)
     show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) :
       \<HH> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH>' \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms show 
       "ntcf_ntsmcf ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) =
         ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>))"
       by 
         (
           cs_concl
             cs_simp: slicing_commute[symmetric] 
             cs_intro: slicing_intros ntsmcf_smcf_comp_ntsmcf_smcf_comp_assoc
         )
   qed simp_all
 qed
 
 lemma (in is_ntcf) ntcf_ntcf_cf_comp_cf_id[cat_cs_simps]:
   "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA> = \<NN>"
 proof(rule ntcf_ntsmcf_eqI)
   show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros)
   show "ntcf_ntsmcf (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_id \<AA>) = ntcf_ntsmcf \<NN>"
     by
       (
         cs_concl
           cs_simp: slicing_commute[symmetric] 
           cs_intro: cat_cs_intros slicing_intros smc_cs_simps
       )
 qed simp_all
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_cf_comp_cf_id
 
 lemma ntcf_vcomp_ntcf_cf_comp[cat_cs_simps]:
   assumes "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "(\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) = (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>"
 proof(rule ntcf_ntsmcf_eqI)
   from assms show 
     "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) :
       \<FF> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms show 
     "ntcf_ntsmcf (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)) =
       ntcf_ntsmcf (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
     unfolding slicing_commute[symmetric]
     by (intro ntsmcf_vcomp_ntsmcf_smcf_comp)
       (cs_concl cs_intro: slicing_intros)
 qed (use assms in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
 
 
 subsection\<open>Composition of a functor and a natural transformation\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 abbreviation (input) cf_ntcf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F" 55)
   where "cf_ntcf_comp \<equiv> dghm_tdghm_comp"
 
 
 text\<open>Slicing.\<close>
 
 lemma ntcf_ntsmcf_cf_ntcf_comp[slicing_commute]: 
   "cf_smcf \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_ntsmcf \<NN> = ntcf_ntsmcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
   unfolding 
     ntcf_ntsmcf_def
     cf_smcf_def
     cat_smc_def
     dghm_tdghm_comp_def 
     dghm_comp_def 
     ntsmcf_tdghm_def 
     smcf_dghm_def 
     smc_dg_def
     dg_field_simps
     dghm_field_simps 
     nt_field_simps 
   by (simp add: nat_omega_simps) (*slow*)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda (in is_ntcf) 
   dghm_tdghm_comp_components(1)[where \<NN>=\<NN>, unfolded ntcf_NTDGDom]
   |vdomain cf_ntcf_comp_NTMap_vdomain|
   |app cf_ntcf_comp_NTMap_app|
 
 lemmas [cat_cs_simps] = 
   is_ntcf.cf_ntcf_comp_NTMap_vdomain
   is_ntcf.cf_ntcf_comp_NTMap_app
 
 lemma cf_ntcf_comp_NTMap_vrange: 
   assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis 
     unfolding dghm_tdghm_comp_components 
     by (auto simp: cat_cs_simps intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>
 Opposite of the composition of a functor and a natural transformation
 \<close>
 
 lemma op_ntcf_cf_ntcf_comp[cat_op_simps]:
   "op_ntcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<NN>"
   unfolding 
     dghm_tdghm_comp_def
     dghm_comp_def
     op_ntcf_def
     op_cf_def
     op_cat_def
     dg_field_simps
     dghm_field_simps
     nt_field_simps
   by (simp add: nat_omega_simps) (*slow*)
 
 
 subsubsection\<open>
 Composition of a functor and a natural transformation 
 is a natural transformation
 \<close>
 
 lemma cf_ntcf_comp_is_ntcf:
   assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<HH> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<HH>: is_functor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
   show ?thesis
   proof(rule is_ntcfI)
     show "vfsequence (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" unfolding dghm_tdghm_comp_def by simp
     from assms show "\<HH> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
       by (cs_concl cs_intro: cat_cs_intros)
     from assms show "\<HH> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     show "vcard (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 5\<^sub>\<nat>"
       unfolding dghm_tdghm_comp_def by (simp add: nat_omega_simps)
     from assms show "ntcf_ntsmcf (\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
       cf_smcf (\<HH> \<circ>\<^sub>C\<^sub>F \<FF>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) :
       cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
       by 
         (
           cs_concl 
             cs_simp: slicing_commute[symmetric]
             cs_intro: slicing_intros smc_cs_intros 
         )
   qed (auto simp: dghm_tdghm_comp_components(1) cat_cs_simps)
 qed
 
 lemma cf_ntcf_comp_is_functor'[cat_cs_intros]:
   assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<FF>' = \<HH> \<circ>\<^sub>C\<^sub>F \<FF>"
     and "\<GG>' = \<HH> \<circ>\<^sub>C\<^sub>F \<GG>"
   shows "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1,2) unfolding assms(3,4) by (simp add: cf_ntcf_comp_is_ntcf)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma cf_comp_cf_ntcf_comp_assoc:
   assumes "\<NN> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof(rule ntcf_ntsmcf_eqI)
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<HH> \<HH>' \<NN> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(2))
   interpret \<GG>: is_functor \<alpha> \<CC> \<DD> \<GG> by (rule assms(3))
   from assms show "(\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> :
     \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) :
     \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms show 
     "ntcf_ntsmcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) =
       ntcf_ntsmcf (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>))"
     by
       (
         cs_concl
           cs_simp: slicing_commute[symmetric] 
           cs_intro: slicing_intros smcf_comp_smcf_ntsmcf_comp_assoc
       )
 qed simp_all
 
 lemma (in is_ntcf) ntcf_cf_ntcf_comp_cf_id[cat_cs_simps]:
   "cf_id \<BB> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = \<NN>"
 proof(rule ntcf_ntsmcf_eqI)
   show "cf_id \<BB> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros)
   show "ntcf_ntsmcf (smcf_id \<BB> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN>) = ntcf_ntsmcf \<NN>"
     by 
       (
         cs_concl
           cs_simp: slicing_commute[symmetric] 
           cs_intro: cat_cs_intros slicing_intros smc_cs_simps
       )
 qed simp_all
 
 lemmas [cat_cs_simps] = is_ntcf.ntcf_cf_ntcf_comp_cf_id
 
 lemma cf_ntcf_comp_ntcf_cf_comp_assoc:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> = \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret \<HH>: is_functor \<alpha> \<CC> \<DD> \<HH> by (rule assms(2))
   interpret \<KK>: is_functor \<alpha> \<AA> \<BB> \<KK> by (rule assms(3))
   show ?thesis
     by (rule ntcf_ntsmcf_eqI)
       (
         use assms in
           \<open>
             cs_concl
               cs_simp: cat_cs_simps slicing_commute[symmetric]
               cs_intro:
                 cat_cs_intros
                 slicing_intros
                 smcf_ntsmcf_comp_ntsmcf_smcf_comp_assoc
           \<close>
       )+
 qed
 
 lemma ntcf_cf_comp_ntcf_id[cat_cs_simps]:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<KK> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> = ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>"
 proof(rule ntcf_eqI)
   from assms have dom_lhs: "\<D>\<^sub>\<circ> ((ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   from assms have dom_rhs: "\<D>\<^sub>\<circ> ((ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show "(ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "(ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<KK>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto intro: cat_cs_intros)
 qed (use assms in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
 lemma cf_comp_cf_const_right[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<aa> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
 proof(rule cf_eqI)
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(3))
 
   from assms(4) show "\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms(4) show "cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(4) have ObjMap_dom_lhs: 
     "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(4) have ObjMap_dom_rhs: 
     "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms(4) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
       cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto intro: assms(4) cat_cs_intros)
   from assms(4) have ArrMap_dom_lhs: 
     "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(4) have ArrMap_dom_rhs: 
     "\<D>\<^sub>\<circ> (cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show
     "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr> = cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     with assms(4) show "(\<GG> \<circ>\<^sub>C\<^sub>F cf_const \<AA> \<BB> \<aa>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> =
       cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto intro: assms(4) cat_cs_intros)
 
 qed simp_all
 
 lemma cf_ntcf_comp_ntcf_vcomp: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
 proof-
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(3))
   show "\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = \<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<KK> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
     by (rule ntcf_ntsmcf_eqI)
       (
         use assms in
           \<open>
             cs_concl
               cs_simp: smc_cs_simps slicing_commute[symmetric]
               cs_intro:
                 cat_cs_intros
                 slicing_intros
                 smcf_ntsmcf_comp_ntsmcf_vcomp
           \<close>
       )+
 qed
 
 
 
 subsection\<open>Constant natural transformation\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III in \cite{mac_lane_categories_2010}.\<close>
 
 definition ntcf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_const \<JJ> \<CC> f = 
     [
       vconst_on (\<JJ>\<lparr>Obj\<rparr>) f, 
       cf_const \<JJ> \<CC> (\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>), 
       cf_const \<JJ> \<CC> (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>), 
       \<JJ>, 
       \<CC>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_const_components:
   shows "ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr> = vconst_on (\<JJ>\<lparr>Obj\<rparr>) f"
     and "ntcf_const \<JJ> \<CC> f\<lparr>NTDom\<rparr> = cf_const \<JJ> \<CC> (\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>)"
     and "ntcf_const \<JJ> \<CC> f\<lparr>NTCod\<rparr> = cf_const \<JJ> \<CC> (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>)"
     and "ntcf_const \<JJ> \<CC> f\<lparr>NTDGDom\<rparr> = \<JJ>"
     and "ntcf_const \<JJ> \<CC> f\<lparr>NTDGCod\<rparr> = \<CC>"
   unfolding ntcf_const_def nt_field_simps by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda ntcf_const_components(1)[folded VLambda_vconst_on]
   |vsv ntcf_const_ObjMap_vsv[cat_cs_intros]|
   |vdomain ntcf_const_ObjMap_vdomain[cat_cs_simps]|
   |app ntcf_const_ObjMap_app[cat_cs_simps]|
 
 lemma ntcf_const_NTMap_ne_vrange: 
   assumes "\<JJ>\<lparr>Obj\<rparr> \<noteq> 0"
   shows "\<R>\<^sub>\<circ> (ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>) = set {f}"
   using assms unfolding ntcf_const_components by simp
 
 lemma ntcf_const_NTMap_vempty_vrange: 
   assumes "\<JJ>\<lparr>Obj\<rparr> = 0"
   shows "\<R>\<^sub>\<circ> (ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>) = 0"
   using assms unfolding ntcf_const_components by simp
 
 
 subsubsection\<open>Constant natural transformation is a natural transformation\<close>
 
 lemma ntcf_const_is_ntcf:
   assumes "category \<alpha> \<JJ>" and "category \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "ntcf_const \<JJ> \<CC> f : cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   show ?thesis  
   proof(intro is_ntcfI')
     show "vfsequence (ntcf_const \<JJ> \<CC> f)" unfolding ntcf_const_def by auto
     show "cf_const \<JJ> \<CC> a : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     proof(rule cf_const_is_functor)
       from assms(3) show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (simp add: cat_cs_intros)
     qed (auto simp: cat_cs_intros)
     from assms(3) show const_b_is_functor: 
       "cf_const \<JJ> \<CC> b : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (auto intro: cf_const_is_functor cat_cs_intros)
     show "vcard (ntcf_const \<JJ> \<CC> f) = 5\<^sub>\<nat>"
       unfolding ntcf_const_def by (simp add: nat_omega_simps)
     show 
       "ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a'\<rparr> : 
         cf_const \<JJ> \<CC> a\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> b\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       if "a' \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a'
       by (simp add: that assms(3) ntcf_const_components(1) dghm_const_ObjMap_app)
     from assms(3) show 
       "ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
         cf_const \<JJ> \<CC> b \<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_const \<JJ> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
       if "f' : a' \<mapsto>\<^bsub>\<JJ>\<^esub> b'" for f' a' b'
       using that dghm_const_ArrMap_app 
       by (auto simp: ntcf_const_components cat_cs_intros cat_cs_simps)
   qed (use assms(3) in \<open>auto simp: ntcf_const_components\<close>)
 qed 
 
 lemma ntcf_const_is_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<JJ>" 
     and "category \<alpha> \<CC>"
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
     and "\<AA> = cf_const \<JJ> \<CC> a"
     and "\<BB> = cf_const \<JJ> \<CC> b"
     and "\<JJ>' = \<JJ>"
     and "\<CC>' = \<CC>"
   shows "ntcf_const \<JJ> \<CC> f : \<AA> \<mapsto>\<^sub>C\<^sub>F \<BB> : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_ntcf)
 
 
 subsubsection\<open>Opposite constant natural transformation\<close>
 
 lemma op_ntcf_ntcf_const[cat_op_simps]: 
   "op_ntcf (ntcf_const \<JJ> \<CC> f) = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
   unfolding 
     nt_field_simps dghm_field_simps dg_field_simps
     dghm_const_def ntcf_const_def op_cat_def op_cf_def op_ntcf_def 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma ntcf_const_ntcf_vcomp[cat_cs_simps]:
   assumes "category \<alpha> \<JJ>" 
     and "category \<alpha> \<CC>" 
     and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" 
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f = ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)"
 proof-
   interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   from assms(3,4) have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c" by (simp add: cat_cs_intros)
   note \<JJ>\<CC>g = ntcf_const_is_ntcf[OF assms(1,2,3)] 
     and \<JJ>\<CC>f = ntcf_const_is_ntcf[OF assms(1,2,4)]
   show ?thesis
   proof(rule ntcf_eqI)
     from ntcf_const_is_ntcf[OF assms(1,2,3)] ntcf_const_is_ntcf[OF assms(1,2,4)]
     show 
       "ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f :
         cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (rule ntcf_vcomp_is_ntcf)
     show
       "ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) : 
         cf_const \<JJ> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (rule ntcf_const_is_ntcf[OF assms(1,2) gf])
     show "(ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)\<lparr>NTMap\<rparr> = 
       ntcf_const \<JJ> \<CC> (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>NTMap\<rparr>"
       unfolding ntcf_const_components
     proof(rule vsv_eqI, unfold ntcf_vcomp_NTMap_vdomain[OF \<JJ>\<CC>f])
       fix a assume prems: "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
       then show 
         "(ntcf_const \<JJ> \<CC> g \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
           vconst_on (\<JJ>\<lparr>Obj\<rparr>) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>a\<rparr>"
         unfolding ntcf_vcomp_NTMap_app[OF \<JJ>\<CC>g \<JJ>\<CC>f prems]  
         by (simp add: ntcf_const_components)
     qed (simp_all add: ntsmcf_vcomp_components)
   qed auto
 qed
 
 lemma ntcf_id_cf_const[cat_cs_simps]: 
   assumes "category \<alpha> \<JJ>" and "category \<alpha> \<CC>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_id (cf_const \<JJ> \<CC> c) = ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)"
 proof(rule ntcf_eqI)
   interpret \<JJ>: category \<alpha> \<JJ> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   from assms show "ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) : 
     cf_const \<JJ> \<CC> c \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (auto intro: ntcf_const_is_ntcf)
   interpret const_c: is_functor \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close>
     by (rule cf_const_is_functor) (auto simp: assms(3) cat_cs_intros)
   show "ntcf_id (cf_const \<JJ> \<CC> c) : 
     cf_const \<JJ> \<CC> c \<mapsto>\<^sub>C\<^sub>F cf_const \<JJ> \<CC> c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (rule const_c.cf_ntcf_id_is_ntcf)
   show "ntcf_id (cf_const \<JJ> \<CC> c)\<lparr>NTMap\<rparr> = ntcf_const \<JJ> \<CC> (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold ntcf_const_components)
     show "vsv (ntcf_id (cf_const \<JJ> \<CC> c)\<lparr>NTMap\<rparr>)"
       unfolding ntcf_id_components by (auto simp: cat_cs_simps intro: vsv_vcomp)
   qed (auto simp: cat_cs_simps)
 qed simp_all
 
 lemma ntcf_cf_comp_cf_const_right[cat_cs_simps]:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "category \<alpha> \<AA>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b = ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(2))
   show ?thesis
   proof(rule ntcf_eqI)
     from assms(3) show "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b :
       cf_const \<AA> \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) :
       \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(3) show "ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) :
       cf_const \<AA> \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) :
       \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(3) have dom_lhs: 
       "\<D>\<^sub>\<circ> ((\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(3) have dom_rhs: 
       "\<D>\<^sub>\<circ> (ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show 
       "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr> = ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       with assms(3) show 
         "(\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F cf_const \<AA> \<BB> b)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
           ntcf_const \<AA> \<CC> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed (auto intro: cat_cs_intros)
   qed simp_all
 qed
 
 lemma cf_ntcf_comp_ntcf_id[cat_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
 proof-
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule ntcf_eqI)
     show "\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     show "ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     have dom_lhs: "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     have dom_rhs: "\<D>\<^sub>\<circ> ((ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show "(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr> = (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       then show 
         "(\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
           (ntcf_id \<GG> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed (cs_concl cs_intro: cat_cs_intros)
   qed simp_all
 qed
 
+lemma (in is_functor) cf_ntcf_cf_comp_ntcf_const[cat_cs_simps]:
+  assumes "category \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
+  shows "ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> = ntcf_const \<AA> \<CC> f"
+proof(rule ntcf_eqI)
+  interpret \<CC>: category \<alpha> \<CC> by (rule assms(1))
+  from assms(2) show "ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> : 
+    cf_const \<AA> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  then have dom_lhs: "\<D>\<^sub>\<circ> ((ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps)
+  from assms(2) show 
+    "ntcf_const \<AA> \<CC> f : cf_const \<AA> \<CC> a \<mapsto>\<^sub>C\<^sub>F cf_const \<AA> \<CC> b : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  then have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
+    by (cs_concl cs_simp: cat_cs_simps)
+  show "(ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr> = ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>"
+  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
+    fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
+    then show 
+      "(ntcf_const \<BB> \<CC> f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_const \<AA> \<CC> f\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
+      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
+qed simp_all
+
+lemmas [cat_cs_simps] = is_functor.cf_ntcf_cf_comp_ntcf_const
+
 
 
 subsection\<open>Natural isomorphism\<close>
 
 
 text\<open>See Chapter I-4 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_iso_ntcf = is_ntcf +
   assumes iso_ntcf_is_arr_isomorphism[cat_arrow_cs_intros]: 
     "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
 
 syntax "_is_iso_ntcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ : _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o _ : _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> 
   "CONST is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"
 
 lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism':
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "B = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> B"
   using assms by (auto intro: cat_arrow_cs_intros)
 
 lemmas [cat_arrow_cs_intros] = 
   is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
 
 lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism'':
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "B = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "F = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
     and "\<BB>' = \<BB>"
   shows "F : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>'\<^esub> B"
   using assms by (auto intro: cat_arrow_cs_intros)
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_iso_ntcf) is_iso_ntcf_axioms'[cat_cs_intros]: 
   assumes "\<alpha>' = \<alpha>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_ntcf_axioms)
 
 mk_ide rf is_iso_ntcf_def[unfolded is_iso_ntcf_axioms_def]
   |intro is_iso_ntcfI|
   |dest is_iso_ntcfD[dest]|
   |elim is_iso_ntcfE[elim]|
 
 lemmas [ntcf_cs_intros] = is_iso_ntcfD(1)
 
 
 
 subsection\<open>Inverse natural transformation\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition inv_ntcf :: "V \<Rightarrow> V"
   where "inv_ntcf \<NN> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<NN>\<lparr>NTDGDom\<rparr>\<lparr>Obj\<rparr>. SOME g. is_inverse (\<NN>\<lparr>NTDGCod\<rparr>) g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)),
       \<NN>\<lparr>NTCod\<rparr>,
       \<NN>\<lparr>NTDom\<rparr>,
       \<NN>\<lparr>NTDGDom\<rparr>,
       \<NN>\<lparr>NTDGCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Slicing.\<close>
 
 lemma inv_ntcf_components:
   shows "inv_ntcf \<NN>\<lparr>NTMap\<rparr> = 
     (\<lambda>a\<in>\<^sub>\<circ>\<NN>\<lparr>NTDGDom\<rparr>\<lparr>Obj\<rparr>. SOME g. is_inverse (\<NN>\<lparr>NTDGCod\<rparr>) g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>))" 
     and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTCod\<rparr>" 
     and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTDom\<rparr>"
     and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDGDom\<rparr> = \<NN>\<lparr>NTDGDom\<rparr>" 
     and [cat_cs_simps]: "inv_ntcf \<NN>\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>" 
   unfolding inv_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Components.\<close>
 
 lemma (in is_iso_ntcf) is_iso_ntcf_inv_ntcf_components[cat_cs_simps]: 
   "inv_ntcf \<NN>\<lparr>NTDom\<rparr> = \<GG>"
   "inv_ntcf \<NN>\<lparr>NTCod\<rparr> = \<FF>"
   "inv_ntcf \<NN>\<lparr>NTDGDom\<rparr> = \<AA>"
   "inv_ntcf \<NN>\<lparr>NTDGCod\<rparr> = \<BB>"
   unfolding inv_ntcf_components by (simp_all add: cat_cs_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma inv_ntcf_NTMap_vsv[cat_cs_intros]: "vsv (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
   unfolding inv_ntcf_components by auto
 
 lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_inverse[cat_cs_intros]:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
 proof-
   from assms is_iso_ntcf_axioms have "\<exists>g. is_inverse \<BB> g (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" by auto
   from assms someI2_ex[OF this] show 
     "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
     unfolding inv_ntcf_components by (simp add: cat_cs_simps)
 qed
 
 lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse[cat_cs_intros]:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)\<inverse>\<^sub>C\<^bsub>\<BB>\<^esub>"
 proof- 
   have "is_inverse \<BB> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
     by (rule iso_ntcf_inv_ntcf_NTMap_app_is_inverse[OF assms])
   from NTDom.HomCod.cat_is_inverse_eq_the_inverse[OF this] show ?thesis .
 qed
 
 lemmas [cat_cs_simps] = is_iso_ntcf.iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse
 
 lemma (in is_ntcf) inv_ntcf_NTMap_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   unfolding inv_ntcf_components by (simp add: cat_cs_simps)
 
 lemmas [cat_cs_simps] = is_ntcf.inv_ntcf_NTMap_vdomain
 
 lemma (in is_iso_ntcf) inv_ntcf_NTMap_vrange: 
   "\<R>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
 proof(rule vsubsetI)
   interpret inv_\<NN>: vsv \<open>inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<close> by (rule inv_ntcf_NTMap_vsv)
   fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
   then obtain a 
     where f_def: "f = inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (inv_ntcf \<NN>\<lparr>NTMap\<rparr>)"
     by (blast elim: inv_\<NN>.vrange_atE)
   then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
   then have "is_inverse \<BB> f (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" 
     unfolding f_def by (intro iso_ntcf_inv_ntcf_NTMap_app_is_inverse)    
   then show "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto
 qed
 
 
 subsubsection\<open>Opposite natural isomorphism\<close>
 
 lemma (in is_iso_ntcf) is_iso_ntcf_op: 
   "op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
 proof-
   from is_iso_ntcf_axioms have 
     "op_ntcf \<NN> : op_cf \<GG> \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   then show ?thesis 
     by (intro is_iso_ntcfI) (auto simp: cat_op_simps cat_arrow_cs_intros)
 qed
 
 lemma (in is_iso_ntcf) is_iso_ntcf_op'[cat_op_intros]:
   assumes "\<GG>' = op_cf \<GG>"
     and "\<FF>' = op_cf \<FF>"
     and "\<AA>' = op_cat \<AA>"
     and "\<BB>' = op_cat \<BB>"
   shows "op_ntcf \<NN> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_ntcf_op)
 
 lemmas is_iso_ntcf_op[cat_op_intros] = is_iso_ntcf.is_iso_ntcf_op
 
 
 
 subsection\<open>A natural isomorphism is an isomorphism in the category \<open>Funct\<close>\<close>
 
 text\<open>
 The results that are presented in this subsection can be found in 
 nLab (see \cite{noauthor_nlab_nodate}\footnote{\url{
 https://ncatlab.org/nlab/show/natural+isomorphism
 }}).
 \<close>
 
 lemma is_arr_isomorphism_is_iso_ntcf:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM> = ntcf_id \<GG>"
     and "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
   shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
   interpret \<MM>: is_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<MM> by (rule assms(2))
   show ?thesis
   proof(rule is_iso_ntcfI)
     fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     proof(rule is_arr_isomorphismI)
       show "is_inverse \<BB> (\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"  
       proof(rule is_inverseI)
         from prems have 
           "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by (simp add: ntcf_vcomp_NTMap_app[OF assms(2,1) prems])
         also have "\<dots> = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" unfolding assms(4) by simp
         also from prems \<NN>.NTDom.ntcf_id_NTMap_app_vdomain have 
           "\<dots> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
           unfolding ntcf_id_components by auto
         finally show "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>".
         from prems have 
           "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by (simp add: ntcf_vcomp_NTMap_app[OF assms(1,2) prems])
         also have "\<dots> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" unfolding assms(3) by simp
         also from prems \<NN>.NTCod.ntcf_id_NTMap_app_vdomain have 
           "\<dots> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
           unfolding ntcf_id_components by auto
         finally show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>".
       qed (auto simp: prems cat_cs_intros)
     qed (auto simp: prems cat_cs_intros)
   qed (auto simp: cat_cs_intros)
 qed
 
 lemma iso_ntcf_is_arr_isomorphism:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows [ntcf_cs_intros]: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
     and "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
 proof-
 
   interpret is_iso_ntcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
   
   define m where "m a = inv_ntcf \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>" for a
   have is_inverse[intro]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> is_inverse \<BB> (m a) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" 
     for a
     unfolding m_def by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   have [dest, intro, simp]: 
     "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" for a
   proof-
     assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     from prems have "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
       by (auto intro: cat_cs_intros cat_arrow_cs_intros)
     with is_inverse[OF prems] show "m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by 
         (
           meson 
             NTDom.HomCod.cat_is_inverse_is_arr_isomorphism is_arr_isomorphismD
         )
   qed
   have [intro]: 
     "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow> m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
     for f a b
   proof-
     assume prems: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     then have ma: "m a : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
       and mb: "m b : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and \<GG>f: "\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
       and \<NN>a: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       and \<FF>f: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       and \<NN>b: "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by (auto intro: cat_cs_intros)
     then have \<NN>b\<FF>f: 
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by (auto intro: cat_cs_intros)
     from prems have inv_ma: "is_inverse \<BB> (m a) (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)" 
       and inv_mb: "is_inverse \<BB> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) (m b)"
       by (auto simp: is_inverse_sym)
     from mb have mb_\<NN>b: "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
       by (auto intro: is_inverse_Comp_CId_right[OF inv_mb])
     from prems have \<NN>a_ma: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a = \<BB>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>" 
       using \<NN>a inv_ma ma by (meson is_inverse_Comp_CId_right)
     from \<GG>f have "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = 
       m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a))"
       unfolding \<NN>a_ma by (cs_concl cs_simp: cat_cs_simps)
     also have "\<dots> = m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ((\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a)"
       by 
          (
           metis 
             ma \<GG>f \<NN>a NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
         )
     also from prems have 
       "\<dots> = m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a)"
       by (metis ntcf_Comp_commute)
     also have "\<dots> = (m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
       by 
         (
           metis 
             \<NN>b\<FF>f ma mb NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
         )
     also from \<FF>f \<NN>b mb NTDom.HomCod.cat_Comp_assoc have 
       "\<dots> =  ((m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>) \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a"
       by (metis is_arr_isomorphismD(1))
     also from \<FF>f have "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a" 
       unfolding mb_\<NN>b by (simp add: cat_cs_simps)
     finally show "m b \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> m a" by simp
   qed
 
   show \<MM>: "inv_ntcf \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   proof(intro is_iso_ntcfI is_ntcfI', unfold m_def[symmetric])
     show "vfsequence (inv_ntcf \<NN>)" unfolding inv_ntcf_def by simp
     show "vcard (inv_ntcf \<NN>) = 5\<^sub>\<nat>"
       unfolding inv_ntcf_def by (simp add: nat_omega_simps)
   qed (auto simp: cat_cs_simps intro: cat_cs_intros)
 
   interpret \<MM>: is_iso_ntcf \<alpha> \<AA> \<BB> \<GG> \<FF> \<open>inv_ntcf \<NN>\<close> by (rule \<MM>)
 
   show \<NN>\<MM>: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id \<GG>"
   proof(rule ntcf_eqI)
     from NTCod.cf_ntcf_id_is_ntcf show "ntcf_id \<GG> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
       by auto
     show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI)
       fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr>)"
       then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         unfolding ntcf_vcomp_NTMap_vdomain[OF \<MM>.is_ntcf_axioms] by simp
       then show "(\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_id \<GG>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_arrow_cs_intros
           )
     qed 
       (
         auto 
           simp: ntsmcf_vcomp_components(1) cat_cs_simps 
           intro: cat_cs_intros
       )
   qed (auto intro: cat_cs_intros)
     
   show \<MM>\<NN>: "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id \<FF>"
   proof(rule ntcf_eqI)
     show "(inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI)
       show "\<D>\<^sub>\<circ> ((inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> (ntcf_id \<FF>\<lparr>NTMap\<rparr>)" 
         by (simp add: ntsmcf_vcomp_components(1) cat_cs_simps)
       fix a assume "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>)"
       then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)    
       then show "(inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_id \<FF>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_arrow_cs_intros
           )
     qed 
       (
         auto simp: 
           ntsmcf_vcomp_components(1) 
           ntcf_id_components(1) 
           cat_cs_simps 
           intro: vsv_vcomp
       )
   qed (auto intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>Vertical composition of natural isomorphisms\<close>
 
 lemma ntcf_vcomp_is_iso_ntcf[cat_cs_intros]:
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof(intro is_arr_isomorphism_is_iso_ntcf)
   note inv_ntcf_\<MM> = iso_ntcf_is_arr_isomorphism[OF assms(1)]
     and inv_ntcf_\<NN> = iso_ntcf_is_arr_isomorphism[OF assms(2)]
   note [cat_cs_simps] = inv_ntcf_\<MM>(2,3) inv_ntcf_\<NN>(2,3)
   from assms show "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   from inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) show 
     "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> : \<HH> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have 
     "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>) = 
       \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>"
     by 
       (
         cs_concl
           cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
       )
   also from assms have "\<dots> = ntcf_id \<HH>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
   finally show "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM>) = ntcf_id \<HH>"
     by simp
   from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have 
     "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 
       inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<MM>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
     by 
       (
         cs_concl 
           cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
       )
   also from assms have "\<dots> = ntcf_id \<FF>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
   finally show "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_id \<FF>"
     by simp
 qed
 
 
 subsubsection\<open>Horizontal composition of natural isomorphisms\<close>
 
 lemma ntcf_hcomp_is_iso_ntcf:
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_arr_isomorphism_is_iso_ntcf)
   note inv_ntcf_\<MM> = iso_ntcf_is_arr_isomorphism[OF assms(1)]
     and inv_ntcf_\<NN> = iso_ntcf_is_arr_isomorphism[OF assms(2)]
   note [cat_cs_simps] = inv_ntcf_\<MM>(2,3) inv_ntcf_\<NN>(2,3)
   from assms show "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   from inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) show 
     "inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> : \<GG>' \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have 
     "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) = 
       ntcf_id \<GG>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<GG>"
     by 
       (
         cs_concl 
           cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps 
           cs_intro: ntcf_cs_intros
       )
   also from assms have "\<dots> = ntcf_id (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
   finally show 
     "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>) = ntcf_id (\<GG>' \<circ>\<^sub>C\<^sub>F \<GG>)"
     by simp
   from assms inv_ntcf_\<MM>(1) inv_ntcf_\<NN>(1) have 
     "inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = 
       ntcf_id \<FF>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF>"
     by 
       (
         cs_concl 
           cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
           cs_intro: ntcf_cs_intros
       )
   also from assms have "\<dots> = ntcf_id (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
   finally show 
     "inv_ntcf \<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_id (\<FF>' \<circ>\<^sub>C\<^sub>F \<FF>)"
     by simp
 qed
 
 lemma ntcf_hcomp_is_iso_ntcf'[ntcf_cs_intros]:
   assumes "\<MM> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<HH>' = \<FF>' \<circ>\<^sub>C\<^sub>F \<FF>"
     and "\<HH>'' = \<GG>' \<circ>\<^sub>C\<^sub>F \<GG>"
   shows "\<MM> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<HH>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH>'' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_iso_ntcf)
 
 
 subsubsection\<open>An identity natural transformation is a natural isomorphism\<close>
 
 lemma (in is_functor) cf_ntcf_id_is_iso_ntcf:
   "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   have "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (auto intro: cat_cs_intros)
   moreover then have "ntcf_id \<FF> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id \<FF> = ntcf_id \<FF>" 
     by (cs_concl cs_simp: cat_cs_simps)
   ultimately show ?thesis by (auto intro: is_arr_isomorphism_is_iso_ntcf)
 qed
 
 lemma (in is_functor) cf_ntcf_id_is_iso_ntcf'[ntcf_cs_intros]:
   assumes "\<GG>' = \<FF>" and "\<HH>' = \<FF>"
   shows "ntcf_id \<FF> : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   unfolding assms by (rule cf_ntcf_id_is_iso_ntcf)
 
 lemmas [ntcf_cs_intros] = is_functor.cf_ntcf_id_is_iso_ntcf'
 
 
 
 subsection\<open>Functor isomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See subsection 1.5 in \cite{bodo_categories_1970}.\<close>
 
 locale iso_functor =
   fixes \<alpha> \<FF> \<GG>
   assumes iso_cf_is_iso_ntcf: "\<exists>\<AA> \<BB> \<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 
 notation iso_functor (infixl "\<approx>\<^sub>C\<^sub>F\<index>" 50)
 
 
 text\<open>Rules.\<close>
 
 lemma iso_functorI:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
   using assms unfolding iso_functor_def by auto
 
 lemma iso_functorD[dest]:
   assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
   shows "\<exists>\<AA> \<BB> \<NN>. \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms unfolding iso_functor_def by auto
 
 lemma iso_functorE[elim]:
   assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
   obtains \<AA> \<BB> \<NN> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms unfolding iso_functor_def by auto
 
 
 subsubsection\<open>A functor isomorphism is an equivalence relation\<close>
 
 lemma iso_functor_refl: 
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
 proof(rule iso_functorI)
   from assms show "ntcf_id \<FF> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by (cs_concl cs_intro: ntcf_cs_intros)
 qed
 
 lemma iso_functor_sym[sym]:
   assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
   shows "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>"
 proof-
   from assms obtain \<AA> \<BB> \<NN> where \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
   from iso_ntcf_is_arr_isomorphism(1)[OF \<NN>] show "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>" 
     by (auto simp: iso_functorI)
 qed
 
 lemma iso_functor_trans[trans, intro]:
   assumes "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>" and "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<HH>"
   shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<HH>"
 proof-
   from assms(1) obtain \<AA> \<BB> \<NN> where \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     by auto
   moreover from assms(2) obtain \<AA>' \<BB>' \<MM>
     where \<MM>: "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'" 
     by auto
   ultimately have "\<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by blast+
   then have eq: "\<AA>' = \<AA>" "\<BB>' = \<BB>" by auto
   from \<MM> have \<MM>: "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" unfolding eq .
   from ntcf_vcomp_is_iso_ntcf[OF \<MM> \<NN>] show ?thesis by (rule iso_functorI)
 qed
 
 
 subsubsection\<open>Opposite functor isomorphism\<close>
 
 lemma (in iso_functor) iso_functor_op: "op_cf \<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<GG>"
 proof-
   from iso_functor_axioms obtain \<AA> \<BB> \<NN> where "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by auto
   from is_iso_ntcf_op[OF this] have "op_cf \<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<FF>" 
     by (auto simp: iso_functorI)
   then show "op_cf \<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> op_cf \<GG>" by (rule iso_functor_sym)
 qed
 
 lemmas iso_functor_op[cat_op_intros] = iso_functor.iso_functor_op
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_PCategory.thy
@@ -1,5829 +1,5829 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Product category\<close>
 theory CZH_ECAT_PCategory
   imports 
     CZH_ECAT_NTCF
     CZH_ECAT_Small_Category
     CZH_Foundations.CZH_SMC_PSemicategory
 begin
 
 
 
 subsection\<open>Background\<close>
 
 
 text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
 
 named_theorems cat_prod_cs_simps
 named_theorems cat_prod_cs_intros
 
 
 
 subsection\<open>Product category: definition and elementary properties\<close> 
 
 definition cat_prod :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V" 
   where "cat_prod I \<AA> =
     [
       (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>),
       (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>),
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Dom\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>)),
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Cod\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>)),
       (
         \<lambda>gf\<in>\<^sub>\<circ>composable_arrs (dg_prod I \<AA>).
           (\<lambda>i\<in>\<^sub>\<circ>I. vpfst gf\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> i\<^esub> vpsnd gf\<lparr>i\<rparr>)
       ),
       (\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>))
     ]\<^sub>\<circ>"
 
 syntax "_PCATEGORY" :: "pttrn \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V" 
   ("(3\<Prod>\<^sub>C_\<in>\<^sub>\<circ>_./ _)" [0, 0, 10] 10)
 translations "\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA>" \<rightleftharpoons> "CONST cat_prod I (\<lambda>i. \<AA>)"
 
 
 text\<open>Components.\<close>
 
 lemma cat_prod_components:
   shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>)"
     and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr> = (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
     and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Dom\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Dom\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>))"
     and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Cod\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Cod\<rparr>\<lparr>f\<lparr>i\<rparr>\<rparr>))"
     and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Comp\<rparr> =
       (
         \<lambda>gf\<in>\<^sub>\<circ>composable_arrs (dg_prod I \<AA>).
           (\<lambda>i\<in>\<^sub>\<circ>I. vpfst gf\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> i\<^esub> vpsnd gf\<lparr>i\<rparr>)
       )"
     and "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr> =
       (\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>))"
   unfolding cat_prod_def dg_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma cat_smc_cat_prod[slicing_commute]: 
   "smc_prod I (\<lambda>i. cat_smc (\<AA> i)) = cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
   unfolding dg_prod_def cat_smc_def cat_prod_def smc_prod_def dg_field_simps
   by (simp_all add: nat_omega_simps)
 
 context
   fixes \<AA> \<phi> :: "V \<Rightarrow> V"
     and \<CC> :: V
 begin
 
 lemmas_with [
   where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close>, unfolded slicing_simps slicing_commute
   ]:
   cat_prod_ObjI = smc_prod_ObjI
   and cat_prod_ObjD = smc_prod_ObjD
   and cat_prod_ObjE = smc_prod_ObjE
   and cat_prod_Obj_cong = smc_prod_Obj_cong
   and cat_prod_ArrI = smc_prod_ArrI
   and cat_prod_ArrD = smc_prod_ArrD
   and cat_prod_ArrE = smc_prod_ArrE
   and cat_prod_Arr_cong = smc_prod_Arr_cong
   and cat_prod_Dom_vsv[cat_cs_intros] = smc_prod_Dom_vsv
   and cat_prod_Dom_vdomain[cat_cs_simps] = smc_prod_Dom_vdomain
   and cat_prod_Dom_app = smc_prod_Dom_app
   and cat_prod_Dom_app_component_app[cat_cs_simps] = 
     smc_prod_Dom_app_component_app
   and cat_prod_Cod_vsv[cat_cs_intros] = smc_prod_Cod_vsv
   and cat_prod_Cod_app = smc_prod_Cod_app
   and cat_prod_Cod_vdomain[cat_cs_simps] = smc_prod_Cod_vdomain
   and cat_prod_Cod_app_component_app[cat_cs_simps] = 
     smc_prod_Cod_app_component_app
   and cat_prod_Comp = smc_prod_Comp
   and cat_prod_Comp_vdomain[cat_cs_simps] = smc_prod_Comp_vdomain
   and cat_prod_Comp_app = smc_prod_Comp_app
   and cat_prod_Comp_app_component[cat_cs_simps] = 
     smc_prod_Comp_app_component
   and cat_prod_Comp_app_vdomain = smc_prod_Comp_app_vdomain
   and cat_prod_vunion_Obj_in_Obj = smc_prod_vunion_Obj_in_Obj
   and cat_prod_vdiff_vunion_Obj_in_Obj = smc_prod_vdiff_vunion_Obj_in_Obj
   and cat_prod_vunion_Arr_in_Arr = smc_prod_vunion_Arr_in_Arr
   and cat_prod_vdiff_vunion_Arr_in_Arr = smc_prod_vdiff_vunion_Arr_in_Arr
 
 end
 
 
 
 subsection\<open>Local assumptions for a product category\<close>
 
 locale pcategory_base = \<Z> \<alpha> for \<alpha> I \<AA> +
   assumes pcat_categories: "i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
     and pcat_index_in_Vset[cat_cs_intros]: "I \<in>\<^sub>\<circ> Vset \<alpha>"
 
 lemma (in pcategory_base) pcat_categories'[cat_prod_cs_intros]:
   assumes "i \<in>\<^sub>\<circ> I" and "\<alpha>' = \<alpha>"
   shows "category \<alpha>' (\<AA> i)" 
   using assms(1) unfolding assms(2) by (rule pcat_categories)
 
 
 text\<open>Rules.\<close>
 
 lemma (in pcategory_base) pcategory_base_axioms'[cat_prod_cs_intros]: 
   assumes "\<alpha>' = \<alpha>" and "I' = I"
   shows "pcategory_base \<alpha>' I' \<AA>"
   unfolding assms by (rule pcategory_base_axioms)
 
 mk_ide rf pcategory_base_def[unfolded pcategory_base_axioms_def]
   |intro pcategory_baseI|
   |dest pcategory_baseD[dest]|
   |elim pcategory_baseE[elim]|
 
 lemma pcategory_base_psemicategory_baseI:
   assumes "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))" 
     and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
   shows "pcategory_base \<alpha> I \<AA>"
 proof-
   interpret psemicategory_base \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
   show ?thesis
     by (intro pcategory_baseI)
       (auto simp: assms(2) psmc_index_in_Vset psmc_Obj_in_Vset psmc_Arr_in_Vset) 
 qed
 
 
 text\<open>Product category is a product semicategory.\<close>
 
 context pcategory_base
 begin
 
 lemma pcat_psemicategory_base: "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
 proof(intro psemicategory_baseI)
   from pcat_index_in_Vset show "I \<in>\<^sub>\<circ> Vset \<alpha>" by auto
 qed (auto simp: category.cat_semicategory cat_prod_cs_intros)
 
 interpretation psmc: psemicategory_base \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
   by (rule pcat_psemicategory_base)
 
 lemmas_with [unfolded slicing_simps slicing_commute]: 
   pcat_Obj_in_Vset = psmc.psmc_Obj_in_Vset
   and pcat_Arr_in_Vset = psmc.psmc_Arr_in_Vset
   and pcat_smc_prod_Obj_in_Vset = psmc.psmc_smc_prod_Obj_in_Vset
   and pcat_smc_prod_Arr_in_Vset = psmc.psmc_smc_prod_Arr_in_Vset
   and cat_prod_Dom_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Dom_app_in_Obj
   and cat_prod_Cod_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Cod_app_in_Obj
   and cat_prod_is_arrI = psmc.smc_prod_is_arrI
   and cat_prod_is_arrD[dest] = psmc.smc_prod_is_arrD
   and cat_prod_is_arrE[elim] = psmc.smc_prod_is_arrE
 
 end
 
 lemma cat_prod_dg_prod_is_arr: 
   "g : b \<mapsto>\<^bsub>dg_prod I \<AA>\<^esub> c \<longleftrightarrow> g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c"
   unfolding is_arr_def cat_prod_def smc_prod_def dg_prod_def dg_field_simps
   by (simp add: nat_omega_simps)
 
 lemma smc_prod_composable_arrs_dg_prod:
   "composable_arrs (dg_prod I \<AA>) = composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
   unfolding composable_arrs_def cat_prod_dg_prod_is_arr by simp
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in pcategory_base) pcat_vsubset_index_pcategory_base:
   assumes "J \<subseteq>\<^sub>\<circ> I"
   shows "pcategory_base \<alpha> J \<AA>"
 proof(intro pcategory_baseI)
   show "category \<alpha> (\<AA> i)" if "i \<in>\<^sub>\<circ> J" for i 
     using that assms by (auto intro: cat_prod_cs_intros)
   from assms show "J \<in>\<^sub>\<circ> Vset \<alpha>" by (simp add: vsubset_in_VsetI cat_cs_intros)
 qed auto
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_prod_CId_vsv[cat_cs_intros]: "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
   unfolding cat_prod_components by auto
 
 lemma cat_prod_CId_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" 
   unfolding cat_prod_components by simp
 
 lemma cat_prod_CId_app: 
   assumes "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
   shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr> = (\<lambda>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>)" 
   using assms unfolding cat_prod_components by simp
 
 lemma cat_prod_CId_app_component[cat_cs_simps]: 
   assumes "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" and "i \<in>\<^sub>\<circ> I"
   shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr>" 
   using assms unfolding cat_prod_components by simp
 
 lemma (in pcategory_base) cat_prod_CId_vrange: 
   "\<R>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)" 
 proof(intro vsubsetI)
   interpret CId: vsv \<open>((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)\<close> by (rule cat_prod_CId_vsv)
   fix f assume "f \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
   then obtain a where f_def: "f = ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)\<lparr>a\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>)"
     by (blast dest: CId.vrange_atD)
   then have a: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" 
     unfolding cat_prod_components by simp
   show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
     unfolding f_def cat_prod_CId_app[OF a]
   proof(rule VLambda_in_vproduct)
     fix i assume prems: "i \<in>\<^sub>\<circ> I"
     interpret \<AA>: category \<alpha> \<open>\<AA> i\<close> 
       by (simp add: \<open>i \<in>\<^sub>\<circ> I\<close> cat_cs_intros cat_prod_cs_intros)
     from prems a have "a\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>" unfolding cat_prod_components by auto
     with is_arrD(1) show "\<AA> i\<lparr>CId\<rparr>\<lparr>a\<lparr>i\<rparr>\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Arr\<rparr>" 
       by (auto intro: cat_cs_intros)
   qed
 qed
 
 
 subsubsection\<open>A product \<open>\<alpha>\<close>-category is a tiny \<open>\<beta>\<close>-category\<close>
 
 lemma (in pcategory_base) pcat_tiny_category_cat_prod:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
   shows "tiny_category \<beta> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
 proof-
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
 
   show ?thesis
   proof(intro tiny_categoryI, (unfold slicing_simps)?)
   
     show \<Pi>: "tiny_semicategory \<beta> (cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i))"
       unfolding slicing_commute[symmetric]
       by 
         (
           intro psemicategory_base.psmc_tiny_semicategory_smc_prod; 
           (rule assms pcat_psemicategory_base)?
         )
     interpret \<Pi>: tiny_semicategory \<beta> \<open>cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> by (rule \<Pi>)
   
     show "vfsequence (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" unfolding cat_prod_def by auto
     show "vcard (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) = 6\<^sub>\<nat>"
       unfolding cat_prod_def by (simp add: nat_omega_simps)
   
     show CId: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> a"
       if a: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" for a
     proof(rule cat_prod_is_arrI)
       have [cat_cs_intros]: "a\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>" if i: "i \<in>\<^sub>\<circ> I" for i
         by (rule cat_prod_ObjD(3)[OF a i])
       from that show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a\<rparr>\<lparr>i\<rparr> : a\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> a\<lparr>i\<rparr>"
         if "i \<in>\<^sub>\<circ> I" for i
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros that
           )
     qed (use that in \<open>auto simp: cat_prod_components cat_prod_CId_app that\<close>)
   
     show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f = f"
       if "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b" for f a b
     proof(rule cat_prod_Arr_cong)
       note f = \<Pi>.smc_is_arrD[unfolded slicing_simps, OF that]
       note a = f(2) and b = f(3) and f = f(1)
       from CId[OF b] have CId_b: 
         "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b"
         by simp
       from \<Pi>.smc_Comp_is_arr[unfolded slicing_simps, OF this that] show 
         "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
         by (simp add: cat_cs_intros)
       from that show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>" by auto
       fix i assume prems: "i \<in>\<^sub>\<circ> I"
       interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: prems cat_prod_cs_intros)
       from prems cat_prod_is_arrD(7)[OF that] have fi: 
         "f\<lparr>i\<rparr> : a\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> b\<lparr>i\<rparr>" 
         by auto
       from prems show "((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> f)\<lparr>i\<rparr> = f\<lparr>i\<rparr>"
         unfolding cat_prod_Comp_app_component[OF CId_b that prems]
         unfolding cat_prod_CId_app[OF b]
         by (auto intro: \<AA>i.cat_CId_left_left[OF fi])
     qed
 
     show "f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> = f"
       if "f : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c" for f b c
     proof(rule cat_prod_Arr_cong)
       note f = \<Pi>.smc_is_arrD[unfolded slicing_simps, OF that]
       note b = f(2) and c = f(3) and f = f(1)
       from CId[OF b] have CId_b: 
         "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> b"
         by simp
       from \<Pi>.smc_Comp_is_arr[unfolded slicing_simps, OF that this] show 
         "f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
         by (simp add: cat_cs_intros)
       from that show "f \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>" by auto
       fix i assume prems: "i \<in>\<^sub>\<circ> I"
       interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: prems cat_prod_cs_intros)
       from prems cat_prod_is_arrD[OF that] have fi: "f\<lparr>i\<rparr> : b\<lparr>i\<rparr> \<mapsto>\<^bsub>\<AA> i\<^esub> c\<lparr>i\<rparr>"
         by simp
       from prems show "(f \<circ>\<^sub>A\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>i\<rparr> = f\<lparr>i\<rparr>"
         unfolding cat_prod_Comp_app_component[OF that CId_b prems]
         unfolding cat_prod_CId_app[OF b]
         by (auto intro: \<AA>i.cat_CId_right_left[OF fi])
     qed
   
   qed (auto simp: cat_cs_intros cat_cs_simps intro: cat_cs_intros)
 
 qed
 
 
 
 subsection\<open>Further local assumptions for product categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 locale pcategory = pcategory_base \<alpha> I \<AA> for \<alpha> I \<AA> +
   assumes pcat_Obj_vsubset_Vset: "J \<subseteq>\<^sub>\<circ> I \<Longrightarrow> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
     and pcat_Hom_vifunion_in_Vset: 
       "\<lbrakk>
         J \<subseteq>\<^sub>\<circ> I;
         A \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr>;
         B \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i)\<lparr>Obj\<rparr>;
         A \<in>\<^sub>\<circ> Vset \<alpha>;
         B \<in>\<^sub>\<circ> Vset \<alpha>
       \<rbrakk> \<Longrightarrow> (\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in pcategory) pcategory_axioms'[cat_prod_cs_intros]: 
   assumes "\<alpha>' = \<alpha>" and "I' = I"
   shows "pcategory \<alpha>' I' \<AA>"
   unfolding assms by (rule pcategory_axioms)
 
 mk_ide rf pcategory_def[unfolded pcategory_axioms_def]
   |intro pcategoryI|
   |dest pcategoryD[dest]|
   |elim pcategoryE[elim]|
 
 lemmas [cat_prod_cs_intros] = pcategoryD(1)
 
 lemma pcategory_psemicategoryI:
   assumes "psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))" 
     and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
   shows "pcategory \<alpha> I \<AA>"
 proof-
   interpret psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
   note [unfolded slicing_simps slicing_commute, cat_cs_intros] = 
     psmc_Obj_vsubset_Vset
     psmc_Hom_vifunion_in_Vset
   show ?thesis
     by (intro pcategoryI pcategory_base_psemicategory_baseI)
       (auto simp: assms(2) smc_prod_cs_intros intro!: cat_cs_intros)
 qed
 
 
 text\<open>Product category is a product semicategory.\<close>
 
 context pcategory
 begin
 
 lemma pcat_psemicategory: "psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))"
 proof(intro psemicategoryI, unfold slicing_simps slicing_commute)
   show "psemicategory_base \<alpha> I (\<lambda>i. cat_smc (\<AA> i))" 
     by (rule pcat_psemicategory_base)
 qed (auto intro!: pcat_Obj_vsubset_Vset pcat_Hom_vifunion_in_Vset)
 
 interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
   by (rule pcat_psemicategory)
 
 lemmas_with [unfolded slicing_simps slicing_commute]: 
   pcat_Obj_vsubset_Vset' = psmc.psmc_Obj_vsubset_Vset'
   and pcat_Hom_vifunion_in_Vset' = psmc.psmc_Hom_vifunion_in_Vset'
   and pcat_cat_prod_vunion_is_arr = psmc.psmc_smc_prod_vunion_is_arr
   and pcat_cat_prod_vdiff_vunion_is_arr = psmc.psmc_smc_prod_vdiff_vunion_is_arr
 
 lemmas_with [unfolded slicing_simps slicing_commute]: 
   pcat_cat_prod_vunion_Comp = psmc.psmc_smc_prod_vunion_Comp
   and pcat_cat_prod_vdiff_vunion_Comp = psmc.psmc_smc_prod_vdiff_vunion_Comp
 
 end
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in pcategory) pcat_vsubset_index_pcategory:
   assumes "J \<subseteq>\<^sub>\<circ> I"
   shows "pcategory \<alpha> J \<AA>"
 proof(intro pcategoryI pcategory_psemicategoryI)
   show "cat_prod J' \<AA>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>" if \<open>J' \<subseteq>\<^sub>\<circ> J\<close> for J'
   proof-
     from that assms have "J' \<subseteq>\<^sub>\<circ> I" by simp
     then show "cat_prod J' \<AA>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>" by (rule pcat_Obj_vsubset_Vset)
   qed
   fix A B J' assume prems:
     "J' \<subseteq>\<^sub>\<circ> J"
     "A \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i)\<lparr>Obj\<rparr>"
     "B \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i)\<lparr>Obj\<rparr>"
     "A \<in>\<^sub>\<circ> Vset \<alpha>" 
     "B \<in>\<^sub>\<circ> Vset \<alpha>"
   show "(\<Union>\<^sub>\<circ>a\<in>\<^sub>\<circ>A. \<Union>\<^sub>\<circ>b\<in>\<^sub>\<circ>B. Hom (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J'. \<AA> i) a b) \<in>\<^sub>\<circ> Vset \<alpha>"
   proof-
     from prems(1) assms have "J' \<subseteq>\<^sub>\<circ> I" by simp
     from pcat_Hom_vifunion_in_Vset[OF this prems(2-5)] show ?thesis.
   qed
   
 qed (rule pcat_vsubset_index_pcategory_base[OF assms])
 
 
 subsubsection\<open>A product \<open>\<alpha>\<close>-category is an \<open>\<alpha>\<close>-category\<close>
 
 lemma (in pcategory) pcat_category_cat_prod: "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
 proof-
   interpret tiny_category \<open>\<alpha> + \<omega>\<close> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i\<close>
     by (intro pcat_tiny_category_cat_prod) 
       (auto simp: \<Z>_\<alpha>_\<alpha>\<omega> \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega>)
   show ?thesis
     by (rule category_if_category)  
       (
         auto 
           intro!: pcat_Hom_vifunion_in_Vset pcat_Obj_vsubset_Vset
           intro: cat_cs_intros
       )
 qed
 
 
 
 subsection\<open>Local assumptions for a finite product category\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 locale finite_pcategory = pcategory_base \<alpha> I \<AA> for \<alpha> I \<AA> +
   assumes fin_pcat_index_vfinite: "vfinite I"
 
 
 text\<open>Rules.\<close>
 
 lemma (in finite_pcategory) finite_pcategory_axioms[cat_prod_cs_intros]: 
   assumes "\<alpha>' = \<alpha>" and "I' = I"
   shows "finite_pcategory \<alpha>' I' \<AA>"
   unfolding assms by (rule finite_pcategory_axioms)
 
 mk_ide rf finite_pcategory_def[unfolded finite_pcategory_axioms_def]
   |intro finite_pcategoryI|
   |dest finite_pcategoryD[dest]|
   |elim finite_pcategoryE[elim]|
 
 lemmas [cat_prod_cs_intros] = finite_pcategoryD(1)
 
 lemma finite_pcategory_finite_psemicategoryI:
   assumes "finite_psemicategory \<alpha> I (\<lambda>i. cat_smc (\<AA> i))" 
     and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> category \<alpha> (\<AA> i)"
   shows "finite_pcategory \<alpha> I \<AA>"
 proof-
   interpret finite_psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> by (rule assms(1))
   show ?thesis
     by 
       (
         intro 
           assms
           finite_pcategoryI 
           pcategory_base_psemicategory_baseI 
           finite_psemicategoryD(1)[OF assms(1)]
           fin_psmc_index_vfinite
       )
 qed
 
 
 subsubsection\<open>
 Local assumptions for a finite product semicategory and local
 assumptions for an arbitrary product semicategory
 \<close>
 
 sublocale finite_pcategory \<subseteq> pcategory \<alpha> I \<AA>
 proof-
   interpret finite_psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close>
   proof(intro finite_psemicategoryI psemicategory_baseI)
     fix i assume "i \<in>\<^sub>\<circ> I"
     then interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> by (simp add: pcat_categories)
     show "semicategory \<alpha> (cat_smc (\<AA> i))" by (simp add: \<AA>i.cat_semicategory)
   qed (auto intro!: cat_cs_intros fin_pcat_index_vfinite)
   show "pcategory \<alpha> I \<AA>"
     by (intro pcategory_psemicategoryI) 
       (simp_all add: pcat_categories psemicategory_axioms)
 qed
 
 
 
 subsection\<open>Binary union and complement\<close>
 
 lemma (in pcategory) pcat_cat_prod_vunion_CId:
   assumes "vdisjnt J K"
     and "J \<subseteq>\<^sub>\<circ> I"
     and "K \<subseteq>\<^sub>\<circ> I"
     and "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>K. \<AA> j)\<lparr>Obj\<rparr>"
   shows 
     "(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>K. \<AA> j)\<lparr>CId\<rparr>\<lparr>b\<rparr> = 
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J \<union>\<^sub>\<circ> K. \<AA> i)\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>"
 proof-
 
   interpret J\<AA>: pcategory \<alpha> J \<AA> 
     using assms(2) by (simp add: pcat_vsubset_index_pcategory)
   interpret K\<AA>: pcategory \<alpha> K \<AA> 
     using assms(3) by (simp add: pcat_vsubset_index_pcategory)
   interpret JK\<AA>: pcategory \<alpha> \<open>J \<union>\<^sub>\<circ> K\<close> \<AA> 
     using assms(2,3) by (simp add: pcat_vsubset_index_pcategory)
 
   interpret J\<AA>': category \<alpha> \<open>cat_prod J \<AA>\<close> 
     by (rule J\<AA>.pcat_category_cat_prod)
   interpret K\<AA>': category \<alpha> \<open>cat_prod K \<AA>\<close> 
     by (rule K\<AA>.pcat_category_cat_prod)
   interpret JK\<AA>': category \<alpha> \<open>cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<close> 
     by (rule JK\<AA>.pcat_category_cat_prod)
 
   from assms(4) have CId_a: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<^esub> a" 
     by (auto intro: cat_cs_intros)
   from assms(5) have CId_b: "cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ck\<in>\<^sub>\<circ>K. \<AA> k)\<^esub> b" 
     by (auto intro: cat_cs_intros)
   have CId_a_CId_b: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> :
     a \<union>\<^sub>\<circ> b \<mapsto>\<^bsub>cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<^esub> a \<union>\<^sub>\<circ> b"
     by (rule pcat_cat_prod_vunion_is_arr[OF assms(1-3) CId_a CId_b])
   from CId_a have a: "a \<in>\<^sub>\<circ> cat_prod J \<AA>\<lparr>Obj\<rparr>" by (auto intro: cat_cs_intros)
   from CId_b have b: "b \<in>\<^sub>\<circ> cat_prod K \<AA>\<lparr>Obj\<rparr>" by (auto intro: cat_cs_intros)
   from CId_a_CId_b have ab: "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Obj\<rparr>" 
     by (auto intro: cat_cs_intros)
 
   note CId_aD = J\<AA>.cat_prod_is_arrD[OF CId_a]
     and CId_bD = K\<AA>.cat_prod_is_arrD[OF CId_b]
 
   show ?thesis
   proof(rule cat_prod_Arr_cong[of _ \<open>J \<union>\<^sub>\<circ> K\<close> \<AA>])
     from CId_a_CId_b show 
       "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Arr\<rparr>"
       by auto
     from ab show "cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr> \<in>\<^sub>\<circ> cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>Arr\<rparr>"
       by (auto intro: JK\<AA>'.cat_is_arrD(1) cat_cs_intros)
     fix i assume "i \<in>\<^sub>\<circ> J \<union>\<^sub>\<circ> K"
     then consider (iJ) \<open>i \<in>\<^sub>\<circ> J\<close> | (iK) \<open>i \<in>\<^sub>\<circ> K\<close> by auto
     then show "(cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> cat_prod K \<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr>)\<lparr>i\<rparr> = 
       cat_prod (J \<union>\<^sub>\<circ> K) \<AA>\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>\<lparr>i\<rparr>"
       by cases
         (
           auto simp: 
             assms(1) 
             CId_aD(1-4) 
             CId_bD(1-4)
             cat_prod_CId_app[OF ab]
             cat_prod_CId_app[OF a]
             cat_prod_CId_app[OF b]
          )
   qed
 
 qed
 
 lemma (in pcategory) pcat_cat_prod_vdiff_vunion_CId:
   assumes "J \<subseteq>\<^sub>\<circ> I"
     and "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> j)\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
   shows 
     "(\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> j)\<lparr>CId\<rparr>\<lparr>a\<rparr> \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>b\<rparr> = 
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>a \<union>\<^sub>\<circ> b\<rparr>"
   by 
     (
       vdiff_of_vunion' 
         rule: pcat_cat_prod_vunion_CId assms: assms(2-3) subset: assms(1)
     )
 
 
 
 subsection\<open>Projection\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_proj :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<close>)
   where "\<pi>\<^sub>C I \<AA> i =
     [
       (\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). a\<lparr>i\<rparr>),
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). f\<lparr>i\<rparr>),
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i),
       \<AA> i
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_proj_components:
   shows "\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>). a\<lparr>i\<rparr>)"
     and "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>). f\<lparr>i\<rparr>)"
     and "\<pi>\<^sub>C I \<AA> i\<lparr>HomDom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
     and "\<pi>\<^sub>C I \<AA> i\<lparr>HomCod\<rparr> = \<AA> i"
   unfolding cf_proj_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing\<close>
 
 lemma cf_smcf_cf_proj[slicing_commute]: 
   "\<pi>\<^sub>S\<^sub>M\<^sub>C I (\<lambda>i. cat_smc (\<AA> i)) i = cf_smcf (\<pi>\<^sub>C I \<AA> i)"
   unfolding 
     cat_smc_def 
     cf_smcf_def 
     smcf_proj_def 
     cf_proj_def 
     cat_prod_def 
     smc_prod_def
     dg_prod_def
     dg_field_simps 
     dghm_field_simps 
   by (simp add: nat_omega_simps)
 
 context pcategory
 begin
 
 interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
   by (rule pcat_psemicategory)
 
 lemmas_with [unfolded slicing_simps slicing_commute]: 
   pcat_cf_proj_is_semifunctor = psmc.psmc_smcf_proj_is_semifunctor
 
 end
 
 
 subsubsection\<open>Projection functor is a functor\<close>
 
 lemma (in pcategory) pcat_cf_proj_is_functor: 
   assumes "i \<in>\<^sub>\<circ> I"
   shows "\<pi>\<^sub>C I \<AA> i : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
 proof(intro is_functorI)
   interpret \<AA>: category \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> 
     by (simp add: pcat_category_cat_prod)
   show "vfsequence (\<pi>\<^sub>C I \<AA> i)" unfolding cf_proj_def by simp
   show "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" by (simp add: \<AA>.category_axioms)
   show "vcard (\<pi>\<^sub>C I \<AA> i) = 4\<^sub>\<nat>"
     unfolding cf_proj_def by (simp add: nat_omega_simps)
   show "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
     if "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>" for c
   proof-
     interpret \<AA>i: category \<alpha> \<open>\<AA> i\<close> 
       by (auto intro: assms cat_prod_cs_intros)
     from that have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<^esub> c"
       by (simp add: \<AA>.cat_CId_is_arr)
     then have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>" 
       by (auto intro: cat_cs_intros)
     with assms have 
       "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<lparr>i\<rparr>"
       unfolding cf_proj_components cat_prod_components by simp
     also from assms have "\<dots> = \<AA> i\<lparr>CId\<rparr>\<lparr>c\<lparr>i\<rparr>\<rparr>"
       unfolding cat_prod_CId_app[OF that] by simp
     also from that have "\<dots> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       unfolding cf_proj_components cat_prod_components by simp
     finally show 
       "\<pi>\<^sub>C I \<AA> i\<lparr>ArrMap\<rparr>\<lparr>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA> i\<lparr>CId\<rparr>\<lparr>\<pi>\<^sub>C I \<AA> i\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       by simp
   qed
 qed 
   (
     auto simp: 
       assms cf_proj_components pcat_cf_proj_is_semifunctor cat_prod_cs_intros
   ) 
 
 lemma (in pcategory) pcat_cf_proj_is_functor':
   assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" and "\<DD> = \<AA> i"
   shows "\<pi>\<^sub>C I \<AA> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1) unfolding assms(2,3) by (rule pcat_cf_proj_is_functor)
 
 lemmas [cat_cs_intros] = pcategory.pcat_cf_proj_is_functor'
 
 
 
 subsection\<open>Category product universal property functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 text\<open>
 The functor that is presented in this section is used in the proof of 
 the universal property of the product category later in this work.
 \<close>
 
 definition cf_up :: "V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "cf_up I \<AA> \<CC> \<phi> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)),
       (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)),
       \<CC>,
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_up_components: 
   shows "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>))"
     and "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. (\<lambda>i\<in>\<^sub>\<circ>I. \<phi> i\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>))"
     and "cf_up I \<AA> \<CC> \<phi>\<lparr>HomDom\<rparr> = \<CC>"
     and "cf_up I \<AA> \<CC> \<phi>\<lparr>HomCod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
   unfolding cf_up_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma smcf_dghm_cf_up[slicing_commute]: 
   "smcf_up I (\<lambda>i. cat_smc (\<AA> i)) (cat_smc \<CC>) (\<lambda>i. cf_smcf (\<phi> i)) = 
     cf_smcf (cf_up I \<AA> \<CC> \<phi>)"
   unfolding 
     cat_smc_def 
     cf_smcf_def 
     cf_up_def 
     smcf_up_def 
     cat_prod_def 
     smc_prod_def
     dg_prod_def
     dg_field_simps 
     dghm_field_simps 
   by (simp add: nat_omega_simps)
 
 context
   fixes \<AA> \<phi> :: "V \<Rightarrow> V"
     and \<CC> :: V
 begin
 
 lemmas_with 
   [
     where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> and \<CC> = \<open>cat_smc \<CC>\<close>, 
     unfolded slicing_simps slicing_commute
   ]:
   cf_up_ObjMap_vdomain[simp] = smcf_up_ObjMap_vdomain
   and cf_up_ObjMap_app = smcf_up_ObjMap_app
   and cf_up_ObjMap_app_vdomain[simp] = smcf_up_ObjMap_app_vdomain
   and cf_up_ObjMap_app_component = smcf_up_ObjMap_app_component
   and cf_up_ArrMap_vdomain[simp] = smcf_up_ArrMap_vdomain
   and cf_up_ArrMap_app = smcf_up_ArrMap_app
   and cf_up_ArrMap_app_vdomain[simp] = smcf_up_ArrMap_app_vdomain
   and cf_up_ArrMap_app_component = smcf_up_ArrMap_app_component
 
 lemma cf_up_ObjMap_vrange:
   assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
   shows "\<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
 proof
   (
     rule smcf_up_ObjMap_vrange[
       where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
         and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> 
         and \<CC>=\<open>cat_smc \<CC>\<close>, 
       unfolded slicing_simps slicing_commute
       ]
   )
   fix i assume "i \<in>\<^sub>\<circ> I"
   then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms)
   show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
     by (rule cf_is_semifunctor)
 qed
 
 lemma cf_up_ObjMap_app_vrange:
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
   shows " \<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Obj\<rparr>)"
 proof
   (
     rule smcf_up_ObjMap_app_vrange[
       where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
         and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> 
         and \<CC>=\<open>cat_smc \<CC>\<close>, 
       unfolded slicing_simps slicing_commute
       ]
   )
   show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (rule assms)
   fix i assume "i \<in>\<^sub>\<circ> I"
   then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2))
   show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
     by (rule cf_is_semifunctor)
 qed
 
 lemma cf_up_ArrMap_vrange:
   assumes "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
   shows "\<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
 proof
   (
     rule smcf_up_ArrMap_vrange[
       where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
         and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> 
         and \<CC>=\<open>cat_smc \<CC>\<close>, 
       unfolded slicing_simps slicing_commute
       ]
   )
   fix i assume "i \<in>\<^sub>\<circ> I"
   then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms)
   show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
     by (rule cf_is_semifunctor)
 qed
 
 lemma cf_up_ArrMap_app_vrange:
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
   shows " \<R>\<^sub>\<circ> (cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>) \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. \<AA> i\<lparr>Arr\<rparr>)"
 proof
   (
     rule smcf_up_ArrMap_app_vrange
       [
         where \<AA>=\<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
           and \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close> 
           and \<CC>=\<open>cat_smc \<CC>\<close>, 
         unfolded slicing_simps slicing_commute
       ]
   )
   fix i assume "i \<in>\<^sub>\<circ> I"
   then interpret is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2))
   show "cf_smcf (\<phi> i) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<AA> i)"
     by (rule cf_is_semifunctor)
 qed (rule assms)
 
 end
 
 context pcategory
 begin
 
 interpretation psmc: psemicategory \<alpha> I \<open>\<lambda>i. cat_smc (\<AA> i)\<close> 
   by (rule pcat_psemicategory)
 
 lemmas_with [unfolded slicing_simps slicing_commute]: 
   pcat_smcf_comp_smcf_proj_smcf_up = psmc.psmc_Comp_smcf_proj_smcf_up
   and pcat_smcf_up_eq_smcf_proj = psmc.psmc_smcf_up_eq_smcf_proj
 
 end
 
 
 subsubsection\<open>Category product universal property functor is a functor\<close>
 
 lemma (in pcategory) pcat_cf_up_is_functor:
   assumes "category \<alpha> \<CC>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i"
   shows "cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
 proof-
   interpret \<CC>: category \<alpha> \<CC> by (simp add: assms(1))
   interpret \<AA>: category \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> by (rule pcat_category_cat_prod)
   show ?thesis
   proof(intro is_functorI)
     show "vfsequence (cf_up I \<AA> \<CC> \<phi>)" unfolding cf_up_def by simp
     show "vcard (cf_up I \<AA> \<CC> \<phi>) = 4\<^sub>\<nat>"
       unfolding cf_up_def by (simp add: nat_omega_simps)
     show "cf_smcf (cf_up I \<AA> \<CC> \<phi>) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
       unfolding slicing_commute[symmetric]
       by (rule psemicategory.psmc_smcf_up_is_semifunctor)
         (
           auto simp: 
             assms(2)
             pcat_psemicategory 
             is_functor.cf_is_semifunctor 
             slicing_intros
         )
     show "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = 
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
     proof(rule cat_prod_Arr_cong)
       from that is_arrD(1) have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" 
         by (auto intro: cat_cs_intros)
       from CId_c cf_up_ArrMap_vrange[OF assms(2), simplified]
       show "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
         unfolding cf_up_components by force
       have cf_up_\<phi>_c: "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Obj\<rparr>"
         unfolding cat_prod_components
       proof(intro vproductI ballI)
         fix i assume prems: "i \<in>\<^sub>\<circ> I"
         interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (simp add: prems assms(2))
         from that show  "cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<AA> i\<lparr>Obj\<rparr>"
           unfolding cf_up_ObjMap_app_component[OF that prems] 
           by (auto intro: cat_cs_intros)
       qed (simp_all add: cf_up_ObjMap_app that cf_up_ObjMap_app[OF that])
       from \<AA>.cat_CId_is_arr[OF this] show 
         "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>Arr\<rparr>"
         by auto
       fix i assume prems: "i \<in>\<^sub>\<circ> I"
       interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (simp add: prems assms(2))
       from cf_up_\<phi>_c prems show 
         "cf_up I \<AA> \<CC> \<phi>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>i\<rparr> =
           (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<lparr>CId\<rparr>\<lparr>cf_up I \<AA> \<CC> \<phi>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>i\<rparr>"
         unfolding cf_up_ArrMap_app_component[OF CId_c prems] cat_prod_components
         by 
           (
             simp add: 
               that cf_up_ObjMap_app_component[OF that prems] \<phi>.cf_ObjMap_CId 
           )
     qed 
   qed (auto simp: cf_up_components cat_cs_intros)
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in pcategory) pcat_Comp_cf_proj_cf_up: 
   assumes "category \<alpha> \<CC>" 
     and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i" 
     and "i \<in>\<^sub>\<circ> I" 
   shows "\<phi> i = \<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F (cf_up I \<AA> \<CC> \<phi>)"
 proof-
   interpret \<phi>: is_functor \<alpha> \<CC> \<open>\<AA> i\<close> \<open>\<phi> i\<close> by (rule assms(2)[OF assms(3)])
   interpret \<pi>: is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>\<AA> i\<close> \<open>\<pi>\<^sub>C I \<AA> i\<close>
     by (simp add: assms(3) pcat_cf_proj_is_functor)
   interpret up: is_functor \<alpha> \<CC> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>cf_up I \<AA> \<CC> \<phi>\<close>
     by (simp add: assms(2) \<phi>.HomDom.category_axioms pcat_cf_up_is_functor)
   show ?thesis
   proof(rule cf_smcf_eqI)
     show "\<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i" 
       by (auto intro: cat_cs_intros)
     from assms show "cf_smcf (\<phi> i) = cf_smcf (\<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F cf_up I \<AA> \<CC> \<phi>)"
       unfolding slicing_simps slicing_commute[symmetric]
       by 
         (
           intro pcat_smcf_comp_smcf_proj_smcf_up[
             where \<phi>=\<open>\<lambda>i. cf_smcf (\<phi> i)\<close>, unfolded slicing_commute[symmetric]
             ]
         )
         (auto simp: is_functor.cf_is_semifunctor)
   qed (auto intro: cat_cs_intros)
 qed
 
 lemma (in pcategory) pcat_cf_up_eq_cf_proj:
   assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
     and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> \<phi> i = \<pi>\<^sub>C I \<AA> i \<circ>\<^sub>C\<^sub>F \<FF>"
   shows "cf_up I \<AA> \<CC> \<phi> = \<FF>"
 proof(rule cf_smcf_eqI)
   interpret \<FF>: is_functor \<alpha> \<CC> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<FF> by (rule assms(1))
   show "cf_up I \<AA> \<CC> \<phi> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)"
   proof(rule pcat_cf_up_is_functor)
     fix i assume prems: "i \<in>\<^sub>\<circ> I"
     then interpret \<pi>: is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<open>\<AA> i\<close> \<open>\<pi>\<^sub>C I \<AA> i\<close>
       by (rule pcat_cf_proj_is_functor)
     show "\<phi> i : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> i" 
       unfolding assms(2)[OF prems] by (auto intro: cat_cs_intros)
   qed (auto intro: cat_cs_intros)
   show "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)" by (rule assms(1))
   from assms show "cf_smcf (cf_up I \<AA> \<CC> \<phi>) = cf_smcf \<FF>"
     unfolding slicing_commute[symmetric]
     by (intro pcat_smcf_up_eq_smcf_proj) (auto simp: slicing_commute)
 qed simp_all
 
 
 
 subsection\<open>Prodfunctor with respect to a fixed argument\<close>
 
 text\<open>
 A prodfunctor is a functor whose domain is a product category. 
 It is a generalization of the concept of the bifunctor,
 as presented in Chapter II-3 in \cite{mac_lane_categories_2010}.  
 \<close>
 
 definition prodfunctor_proj :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "prodfunctor_proj \<SS> I \<AA> \<DD> J c =
     [
       (\<lambda>b\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>),
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>),
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i),
       \<DD>
     ]\<^sub>\<circ>"
 
 syntax "_PPRODFUNCTOR_PROJ" :: "V \<Rightarrow> pttrn \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" 
   (\<open>(_\<^bsub>(3\<Prod>\<^sub>C_\<in>\<^sub>\<circ>_-\<^sub>\<circ>_./_),_\<^esub>/'(/-,_/'))\<close> [51, 51, 51, 51, 51, 51, 51] 51)
 translations "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I-\<^sub>\<circ>J. \<AA>,\<DD>\<^esub>(-,c)" \<rightleftharpoons> 
   "CONST prodfunctor_proj \<SS> I (\<lambda>i. \<AA>) \<DD> J c"
 
 
 text\<open>Components.\<close>
 
 lemma prodfunctor_proj_components:
   shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>ObjMap\<rparr> = 
       (\<lambda>b\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)"
     and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>ArrMap\<rparr> = 
       (\<lambda>f\<in>\<^sub>\<circ>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)"
     and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>HomDom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)"
     and "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c))\<lparr>HomCod\<rparr> = \<DD>"
   unfolding prodfunctor_proj_def dghm_field_simps
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda prodfunctor_proj_components(1)
   |vsv prodfunctor_proj_ObjMap_vsv[cat_cs_intros]|
   |vdomain prodfunctor_proj_ObjMap_vdomain[cat_cs_simps]|
   |app prodfunctor_proj_ObjMap_app[cat_cs_simps]|
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda prodfunctor_proj_components(2)
   |vsv prodfunctor_proj_ArrMap_vsv[cat_cs_intros]|
   |vdomain prodfunctor_proj_ArrMap_vdomain[cat_cs_simps]|
   |app  prodfunctor_proj_ArrMap_app[cat_cs_simps]|
 
 
 subsubsection\<open>Prodfunctor with respect to a fixed argument is a functor\<close>
 
 lemma (in pcategory) pcat_prodfunctor_proj_is_functor: 
   assumes "\<SS> : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
     and "J \<subseteq>\<^sub>\<circ> I"
   shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c)) : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
 
   interpret is_functor \<alpha> \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i)\<close> \<DD> \<SS> by (rule assms(1))
   interpret \<AA>: pcategory \<alpha> J \<AA>
     using assms(3) by (intro pcat_vsubset_index_pcategory) auto
   interpret J_\<AA>: category \<alpha> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>J. \<AA> i\<close> by (rule \<AA>.pcat_category_cat_prod)
   interpret IJ: pcategory \<alpha> \<open>I -\<^sub>\<circ> J\<close> \<AA>
     using assms(3) by (intro pcat_vsubset_index_pcategory) auto
   interpret IJ_\<AA>: category \<alpha> \<open>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i\<close>
     by (rule IJ.pcat_category_cat_prod)
 
   let ?IJ\<AA> = \<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)\<close>
 
   from assms(2) have "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. \<AA> j\<lparr>Obj\<rparr>)"
     unfolding cat_prod_components by simp
   then have "(\<Prod>\<^sub>\<circ>j\<in>\<^sub>\<circ>J. \<AA> j\<lparr>Obj\<rparr>) \<noteq> 0" by (auto intro!: cat_cs_intros)
 
   show ?thesis
   proof(intro is_functorI', unfold prodfunctor_proj_components)
 
     show "vfsequence (prodfunctor_proj \<SS> I \<AA> \<DD> J c)"
       unfolding prodfunctor_proj_def by simp
     show "vcard (prodfunctor_proj \<SS> I \<AA> \<DD> J c) = 4\<^sub>\<nat>"
       unfolding prodfunctor_proj_def by (simp add: nat_omega_simps)
 
     show "\<R>\<^sub>\<circ> (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
     proof(intro vsubsetI)
       fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)"
       then obtain b where x_def: "x = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>" and b: "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>"  
         by auto
       have "b \<union>\<^sub>\<circ> c \<in>\<^sub>\<circ> cat_prod I \<AA>\<lparr>Obj\<rparr>"
       proof(rule cat_prod_vdiff_vunion_Obj_in_Obj)
         show "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" by (rule b)
       qed (intro assms(2,3))+
       then show "x \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>" unfolding x_def by (auto intro: cat_cs_intros)
     qed
 
     show is_arr:
       "(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>f\<rparr> : 
         (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> 
         (\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>b\<rparr>"
       (is \<open>?V_f: ?V_a \<mapsto>\<^bsub>\<DD>\<^esub> ?V_b\<close>)
       if "f : a \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b" for f a b
     proof-
       let ?fc = \<open>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<close>
       have "?fc : a \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> b \<union>\<^sub>\<circ> c"
       proof(rule pcat_cat_prod_vdiff_vunion_is_arr)
         show "f : a \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b" by (rule that)
       qed (auto simp: assms cat_cs_intros)
       then have "\<SS>\<lparr>ArrMap\<rparr>\<lparr>?fc\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>a \<union>\<^sub>\<circ> c\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>"
         by (auto intro: cat_cs_intros)
       moreover from that have "f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" "a \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>"
         by (auto intro: cat_cs_intros) 
       ultimately show ?thesis by simp
     qed
 
     show 
       "(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> 
       (\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>f\<rparr>"
       if "g : b' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> c'" and "f : a' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> b'" for g b' c' f a'
     proof-
       from that have gf: "g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f : a' \<mapsto>\<^bsub>?IJ\<AA>\<^esub> c'" 
         by (auto intro: cat_cs_intros)
       from assms(2) have CId_c: "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>cat_prod J \<AA>\<^esub> c" 
         by (auto intro: cat_cs_intros)
       then have [simp]:  
         "cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> \<circ>\<^sub>A\<^bsub>cat_prod J \<AA>\<^esub> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> = 
           cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>"
         by (auto simp: cat_cs_simps)
       from assms(3) that(1) CId_c have g_CId_c:
         "g \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : b' \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> c' \<union>\<^sub>\<circ> c"
         by (rule pcat_cat_prod_vdiff_vunion_is_arr)
       from assms(3) that(2) CId_c have f_CId_c:
         "f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> : a' \<union>\<^sub>\<circ> c \<mapsto>\<^bsub>cat_prod I \<AA>\<^esub> b' \<union>\<^sub>\<circ> c"
         by (rule pcat_cat_prod_vdiff_vunion_is_arr)
       have 
         "\<SS>\<lparr>ArrMap\<rparr>\<lparr>(g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f) \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = 
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>g \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>"
         unfolding 
           pcat_cat_prod_vdiff_vunion_Comp[
             OF assms(3) that(1) CId_c that(2) CId_c, simplified
             ]
         by (intro cf_ArrMap_Comp[OF g_CId_c f_CId_c])
       moreover from gf have "g \<circ>\<^sub>A\<^bsub>?IJ\<AA>\<^esub> f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" by auto
       moreover from that have "g \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" "f \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>" by auto
       ultimately show ?thesis by simp
     qed
 
     show 
       "(\<lambda>f\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Arr\<rparr>. \<SS>\<lparr>ArrMap\<rparr>\<lparr>f \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr>\<rparr> = 
         \<DD>\<lparr>CId\<rparr>\<lparr>(\<lambda>b\<in>\<^sub>\<circ>?IJ\<AA>\<lparr>Obj\<rparr>. \<SS>\<lparr>ObjMap\<rparr>\<lparr>b \<union>\<^sub>\<circ> c\<rparr>)\<lparr>c'\<rparr>\<rparr>"
       if "c' \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Obj\<rparr>" for c'
     proof-
       have "?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr> = cat_prod I \<AA>\<lparr>CId\<rparr>\<lparr>c' \<union>\<^sub>\<circ> c\<rparr>"
         unfolding pcat_cat_prod_vdiff_vunion_CId[OF assms(3) that assms(2)] ..
       moreover from assms(3) that assms(2) have "c' \<union>\<^sub>\<circ> c \<in>\<^sub>\<circ> cat_prod I \<AA>\<lparr>Obj\<rparr>"
         by (rule cat_prod_vdiff_vunion_Obj_in_Obj)
       ultimately have "\<SS>\<lparr>ArrMap\<rparr>\<lparr>?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<union>\<^sub>\<circ> cat_prod J \<AA>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
         \<DD>\<lparr>CId\<rparr>\<lparr>\<SS>\<lparr>ObjMap\<rparr>\<lparr>c' \<union>\<^sub>\<circ> c\<rparr>\<rparr>"
         by (auto intro: cat_cs_intros) 
       moreover from that have CId_c': "?IJ\<AA>\<lparr>CId\<rparr>\<lparr>c'\<rparr> \<in>\<^sub>\<circ> ?IJ\<AA>\<lparr>Arr\<rparr>"
         by (auto dest!: IJ_\<AA>.cat_CId_is_arr)
       ultimately show ?thesis by (simp add: that)
     qed
 
   qed (auto intro: cat_cs_intros) 
 
 qed
 
 lemma (in pcategory) pcat_prodfunctor_proj_is_functor': 
   assumes "\<SS> : (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I. \<AA> i) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "c \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>J. \<AA> j)\<lparr>Obj\<rparr>"
     and "J \<subseteq>\<^sub>\<circ> I"
     and "\<AA>' = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i)"
     and "\<BB>' = \<DD>"
   shows "(\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>I -\<^sub>\<circ> J. \<AA> i,\<DD>\<^esub>(-,c)) : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1-3)
   unfolding assms(4,5)
   by (rule pcat_prodfunctor_proj_is_functor)
 
 lemmas [cat_cs_intros] = pcategory.pcat_prodfunctor_proj_is_functor'
 
 
 
 subsection\<open>Singleton category\<close>
 
 
 subsubsection\<open>Slicing\<close>
 
 context
   fixes \<CC> :: V
 begin
 
 lemmas_with [where \<CC>=\<open>cat_smc \<CC>\<close>, unfolded slicing_simps slicing_commute]:
   cat_singleton_ObjI = smc_singleton_ObjI
   and cat_singleton_ObjE = smc_singleton_ObjE
   and cat_singleton_ArrI = smc_singleton_ArrI
   and cat_singleton_ArrE = smc_singleton_ArrE
 
 end
 
 context category
 begin
 
 interpretation smc: semicategory \<alpha> \<open>cat_smc \<CC>\<close> by (rule cat_semicategory)
 
 lemmas_with [unfolded slicing_simps slicing_commute]:
   cat_finite_psemicategory_cat_singleton = 
     smc.smc_finite_psemicategory_smc_singleton
   and cat_singleton_is_arrI = smc.smc_singleton_is_arrI
   and cat_singleton_is_arrD = smc.smc_singleton_is_arrD
   and cat_singleton_is_arrE = smc.smc_singleton_is_arrE
 
 end
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_singleton_CId_app: 
   assumes "set {\<langle>j, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>Obj\<rparr>"
   shows "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>set {\<langle>j, a\<rangle>}\<rparr> = set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rangle>}"
   using assms unfolding cat_prod_components VLambda_vsingleton by simp
 
 
 subsubsection\<open>Singleton category is a category\<close>
 
 lemma (in category) cat_finite_pcategory_cat_singleton: 
   assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
   shows "finite_pcategory \<alpha> (set {j}) (\<lambda>i. \<CC>)"
   by 
     (
       auto intro: 
         assms
         category_axioms 
         finite_pcategory_finite_psemicategoryI 
         cat_finite_psemicategory_cat_singleton 
     )
 
 lemma (in category) cat_category_cat_singleton:
   assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
   shows "category \<alpha> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
 proof-
   interpret finite_pcategory \<alpha> \<open>set {j}\<close> \<open>\<lambda>i. \<CC>\<close>
     using assms by (rule cat_finite_pcategory_cat_singleton)
   show ?thesis by (rule pcat_category_cat_prod)
 qed
 
 
 
 subsection\<open>Singleton functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition cf_singleton :: "V \<Rightarrow> V \<Rightarrow> V"
   where "cf_singleton j \<CC> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. set {\<langle>j, a\<rangle>}),
       (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. set {\<langle>j, f\<rangle>}),
       \<CC>,
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_singleton_components:
   shows "cf_singleton j \<CC>\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. set {\<langle>j, a\<rangle>})"
     and "cf_singleton j \<CC>\<lparr>ArrMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>\<CC>\<lparr>Arr\<rparr>. set {\<langle>j, f\<rangle>})"
     and "cf_singleton j \<CC>\<lparr>HomDom\<rparr> = \<CC>"
     and "cf_singleton j \<CC>\<lparr>HomCod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
   unfolding cf_singleton_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_cf_singleton[slicing_commute]: 
   "smcf_singleton j (cat_smc \<CC>)= cf_smcf (cf_singleton j \<CC>)"
   unfolding smcf_singleton_def cf_singleton_def slicing_simps slicing_commute
   by 
     (
       simp add: 
         nat_omega_simps dghm_field_simps dg_field_simps cat_smc_def cf_smcf_def
      )
 
 context
   fixes \<CC> :: V
 begin
 
 lemmas_with [where \<CC>=\<open>cat_smc \<CC>\<close>, unfolded slicing_simps slicing_commute]:
   cf_singleton_ObjMap_vsv[cat_cs_intros] = smcf_singleton_ObjMap_vsv
   and cf_singleton_ObjMap_vdomain[cat_cs_simps] = smcf_singleton_ObjMap_vdomain
   and cf_singleton_ObjMap_vrange = smcf_singleton_ObjMap_vrange
   and cf_singleton_ObjMap_app[cat_prod_cs_simps] = smcf_singleton_ObjMap_app
   and cf_singleton_ArrMap_vsv[cat_cs_intros] = smcf_singleton_ArrMap_vsv
   and cf_singleton_ArrMap_vdomain[cat_cs_simps] = smcf_singleton_ArrMap_vdomain
   and cf_singleton_ArrMap_vrange = smcf_singleton_ArrMap_vrange
   and cf_singleton_ArrMap_app[cat_prod_cs_simps] = smcf_singleton_ArrMap_app
 
 end
 
 
 subsubsection\<open>Singleton functor is an isomorphism of categories\<close>
 
 lemma (in category) cat_cf_singleton_is_functor:
   assumes "j \<in>\<^sub>\<circ> Vset \<alpha>"
   shows "cf_singleton j \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
 proof(intro is_iso_functorI is_functorI)
   from assms show smcf_singleton: "cf_smcf (cf_singleton j \<CC>) : 
     cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
     unfolding slicing_commute[symmetric]
     by (intro semicategory.smc_smcf_singleton_is_iso_semifunctor) 
       (auto intro: smc_cs_intros slicing_intros)
   show "vfsequence (cf_singleton j \<CC>)" unfolding cf_singleton_def by simp
   show "vcard (cf_singleton j \<CC>) = 4\<^sub>\<nat>"
     unfolding cf_singleton_def by (simp add: nat_omega_simps)
   show "cf_smcf (cf_singleton j \<CC>) : 
     cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)"
     by (intro is_iso_semifunctor.axioms(1) smcf_singleton)
   show "cf_singleton j \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = 
     (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>cf_singleton j \<CC>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
     if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c 
   proof-
     from that have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c" by (auto simp: cat_cs_intros)
     have "set {\<langle>j, c\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>Obj\<rparr>"
       by (simp add: cat_singleton_ObjI that)
     with that have "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {j}. \<CC>)\<lparr>CId\<rparr>\<lparr>cf_singleton j \<CC>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> = 
       set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rangle>}"
       by (simp add: cf_singleton_ObjMap_app cat_singleton_CId_app)
     moreover from CId_c have 
       "cf_singleton j \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = set {\<langle>j, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rangle>}"
       by (auto simp: cf_singleton_ArrMap_app cat_cs_intros)
     ultimately show ?thesis by simp
   qed
 qed 
   (
     auto simp: 
       cat_cs_intros assms cat_category_cat_singleton cf_singleton_components 
   )
 
 
 
 subsection\<open>Product of two categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties.\<close>
 
 
 text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cat_prod_2 :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<times>\<^sub>C\<close> 80)
   where "\<AA> \<times>\<^sub>C \<BB> \<equiv> cat_prod (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>)"
 
 
 text\<open>Slicing.\<close>
   
 lemma cat_smc_cat_prod_2[slicing_commute]: 
   "cat_smc \<AA> \<times>\<^sub>S\<^sub>M\<^sub>C cat_smc \<BB> = cat_smc (\<AA> \<times>\<^sub>C \<BB>)"
   unfolding cat_prod_2_def smc_prod_2_def slicing_commute[symmetric] if_distrib
   by simp
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 lemmas_with 
   [
     where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>, 
     unfolded slicing_simps slicing_commute, 
     OF \<AA>.cat_semicategory \<BB>.cat_semicategory
   ]:
   cat_prod_2_ObjI = smc_prod_2_ObjI 
   and cat_prod_2_ObjI'[cat_prod_cs_intros] = smc_prod_2_ObjI'
   and cat_prod_2_ObjE = smc_prod_2_ObjE
   and cat_prod_2_ArrI = smc_prod_2_ArrI
   and cat_prod_2_ArrI'[cat_prod_cs_intros] = smc_prod_2_ArrI'
   and cat_prod_2_ArrE = smc_prod_2_ArrE
   and cat_prod_2_is_arrI = smc_prod_2_is_arrI
   and cat_prod_2_is_arrI'[cat_prod_cs_intros] = smc_prod_2_is_arrI'
   and cat_prod_2_is_arrE = smc_prod_2_is_arrE
   and cat_prod_2_Dom_vsv = smc_prod_2_Dom_vsv
   and cat_prod_2_Dom_vdomain[cat_cs_simps] = smc_prod_2_Dom_vdomain
   and cat_prod_2_Dom_app[cat_prod_cs_simps] = smc_prod_2_Dom_app
   and cat_prod_2_Dom_vrange = smc_prod_2_Dom_vrange
   and cat_prod_2_Cod_vsv = smc_prod_2_Cod_vsv
   and cat_prod_2_Cod_vdomain[cat_cs_simps] = smc_prod_2_Cod_vdomain
   and cat_prod_2_Cod_app[cat_prod_cs_simps] = smc_prod_2_Cod_app
   and cat_prod_2_Cod_vrange = smc_prod_2_Cod_vrange
   and cat_prod_2_op_cat_cat_Obj[cat_op_simps] = smc_prod_2_op_smc_smc_Obj
   and cat_prod_2_cat_op_cat_Obj[cat_op_simps] = smc_prod_2_smc_op_smc_Obj
   and cat_prod_2_op_cat_cat_Arr[cat_op_simps] = smc_prod_2_op_smc_smc_Arr
   and cat_prod_2_cat_op_cat_Arr[cat_op_simps] = smc_prod_2_smc_op_smc_Arr
 
 lemmas_with 
   [
     where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>, 
     unfolded slicing_simps slicing_commute, 
     OF \<AA>.cat_semicategory \<BB>.cat_semicategory
   ]:
   cat_prod_2_Comp_app[cat_prod_cs_simps] = smc_prod_2_Comp_app
 
 end
 
 
 subsubsection\<open>Product of two categories is a category\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 lemma finite_pcategory_cat_prod_2: "finite_pcategory \<alpha> (2\<^sub>\<nat>) (if2 \<AA> \<BB>)"
 proof(intro finite_pcategoryI pcategory_baseI)
   from Axiom_of_Infinity show z1_in_Vset: "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by blast
   show "category \<alpha> (i = 0 ? \<AA> : \<BB>)" if "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>" for i
     by (auto simp: cat_cs_intros)
 qed auto
 
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemma category_cat_prod_2[cat_cs_intros]: "category \<alpha> (\<AA> \<times>\<^sub>C \<BB>)"
   unfolding cat_prod_2_def by (rule pcat_category_cat_prod)
 
 end
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_prod_2_CId_vsv[cat_cs_intros]: "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)"
   unfolding cat_prod_2_def cat_prod_components by simp
 
 lemma cat_prod_2_CId_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   unfolding cat_prod_2_def cat_prod_components by simp
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>(\<lambda>i. if i = 0 then \<AA> else \<BB>)\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemma cat_prod_2_CId_app[cat_prod_cs_simps]:
   assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   shows "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
 proof-
-  have "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr> \<lparr>a, b\<rparr>\<^sub>\<bullet> = 
+  have "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = 
     (\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)"
     by 
       (
         rule 
           cat_prod_CId_app[
             OF assms[unfolded cat_prod_2_def], folded cat_prod_2_def
             ]
       )
   also have 
     "(\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>) = 
       [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
   proof(rule vsv_eqI, unfold vdomain_VLambda)
     fix i assume "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
     then consider \<open>i = 0\<close> | \<open>i = 1\<^sub>\<nat>\<close> unfolding two by auto
     then show 
       "(\<lambda>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. (if i = 0 then \<AA> else \<BB>)\<lparr>CId\<rparr>\<lparr>[a, b]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)\<lparr>i\<rparr> = 
         [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<lparr>i\<rparr>"
       by cases (simp_all add: two nat_omega_simps)
   qed (auto simp: two nat_omega_simps)
   finally show ?thesis by simp
 qed
 
 lemma cat_prod_2_CId_vrange: "\<R>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
   show "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
   fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   then obtain a b where ab_def: "ab = [a, b]\<^sub>\<circ>" 
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     by (elim cat_prod_2_ObjE[OF \<AA> \<BB>])
   from \<AA> \<BB> a b show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
     unfolding ab_def 
     by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
 qed
 
 end
 
 
 subsubsection\<open>Opposite product category\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 lemma op_smc_smc_prod_2[smc_op_simps]: 
   "op_cat (\<AA> \<times>\<^sub>C \<BB>) = op_cat \<AA> \<times>\<^sub>C op_cat \<BB>"
 proof(rule cat_smc_eqI [of \<alpha>])
   from \<AA> \<BB> show cat_lhs: "category \<alpha> (op_cat (\<AA> \<times>\<^sub>C \<BB>))"
     by 
       (
         cs_concl 
           cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
       )
   interpret cat_lhs: category \<alpha> \<open>op_cat (\<AA> \<times>\<^sub>C \<BB>)\<close> by (rule cat_lhs)
   from \<AA> \<BB> show cat_rhs: "category \<alpha> (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)"
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
       )
   interpret cat_rhs: category \<alpha> \<open>op_cat \<AA> \<times>\<^sub>C op_cat \<BB>\<close> by (rule cat_rhs)
   show "op_cat (\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>"
     unfolding cat_op_simps
   proof(rule vsv_eqI, unfold cat_cs_simps)
     show "vsv ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
     show "vsv ((op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>)" by (rule cat_prod_2_CId_vsv)
     from \<AA> \<BB> show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
     show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr>"
       if "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab
       using that unfolding cat_cs_simps
     proof-
       from that obtain a b
         where ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF \<AA> \<BB>])
       from \<AA> \<BB> a b show "(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr> = (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)\<lparr>CId\<rparr>\<lparr>ab\<rparr>"
         unfolding ab_def
         by 
           (
             cs_concl
               cs_simp: cat_op_simps cat_prod_cs_simps
               cs_intro: cat_op_intros cat_prod_cs_intros
           )
     qed
   qed
 
   from \<AA> \<BB> show "cat_smc (op_cat (\<AA> \<times>\<^sub>C \<BB>)) = cat_smc (op_cat \<AA> \<times>\<^sub>C op_cat \<BB>)"
     unfolding slicing_commute[symmetric]
     by (cs_concl cs_simp: smc_op_simps cs_intro: slicing_intros)
 
 qed
 
 end
 
 
 subsubsection\<open>Flip\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 lemma cat_prod_2_Obj_fconverse[cat_cs_simps]:
   "((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet> = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
 proof-
   interpret fbrelation \<open>((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<close> 
     by (auto elim: cat_prod_2_ObjE[OF \<AA> \<BB>])
   show ?thesis
   proof(intro vsubset_antisym vsubsetI)
     fix ba assume prems: "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet>"
     then obtain a b where ba_def: "ba = [b, a]\<^sub>\<circ>" by clarsimp
     from prems[unfolded ba_def] have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" by auto
     then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by (auto elim: cat_prod_2_ObjE[OF \<AA> \<BB>])
     with \<AA> \<BB> show "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       unfolding ba_def by (cs_concl cs_intro: cat_prod_cs_intros)
   next
     fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"  
     then obtain a b 
       where ba_def: "ba = [b, a]\<^sub>\<circ>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       by (elim cat_prod_2_ObjE[OF \<BB> \<AA>])
     from b a show "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>)\<inverse>\<^sub>\<bullet>"
       unfolding ba_def by (auto simp: cat_prod_2_ObjI[OF \<AA> \<BB> a b])
   qed
 qed
 
 lemma cat_prod_2_Arr_fconverse[cat_cs_simps]:
   "((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet> = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
 proof-
   interpret fbrelation \<open>((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<close> 
     by (auto elim: cat_prod_2_ArrE[OF \<AA> \<BB>])
   show ?thesis
   proof(intro vsubset_antisym vsubsetI)
     fix ba assume prems: "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet>"
     then obtain a b where ba_def: "ba = [b, a]\<^sub>\<circ>" by clarsimp
     from prems[unfolded ba_def] have "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>" by auto
     then have "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
       by (auto elim: cat_prod_2_ArrE[OF \<AA> \<BB>])
     with \<AA> \<BB> show "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
       unfolding ba_def 
       by 
         (
           cs_concl 
             cs_simp: cat_prod_cs_simps 
             cs_intro: cat_prod_cs_intros cat_cs_intros
         )
   next
     fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"  
     then obtain a b 
       where ba_def: "ba = [b, a]\<^sub>\<circ>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
       by (elim cat_prod_2_ArrE[OF \<BB> \<AA>])
     from b a show "ba \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>)\<inverse>\<^sub>\<bullet>"
       unfolding ba_def by (auto simp: cat_prod_2_ArrI[OF \<AA> \<BB> a b])
   qed
 qed
 
 end
 
 
 
 subsection\<open>Projections for the product of two categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<^sub>.\<^sub>1\<close>)
   where "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> = cf_proj (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>) 0"
 definition cf_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>\<pi>\<^sub>C\<^sub>.\<^sub>2\<close>)
   where "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> = cf_proj (2\<^sub>\<nat>) (\<lambda>i. if i = 0 then \<AA> else \<BB>) (1\<^sub>\<nat>)"
 
 
 text\<open>Slicing\<close>
 
 lemma cf_smcf_cf_proj_fst[slicing_commute]: 
   "\<pi>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>1 (cat_smc \<AA>) (cat_smc \<BB>) = cf_smcf (\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>)"
   unfolding 
     cf_proj_fst_def smcf_proj_fst_def slicing_commute[symmetric] if_distrib ..
 
 lemma cf_smcf_cf_proj_snd[slicing_commute]: 
   "\<pi>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>2 (cat_smc \<AA>) (cat_smc \<BB>) = cf_smcf (\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>)"
   unfolding 
     cf_proj_snd_def smcf_proj_snd_def slicing_commute[symmetric] if_distrib ..
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 lemmas_with 
   [
     where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close>, 
     unfolded slicing_simps slicing_commute, 
     OF \<AA>.cat_semicategory \<BB>.cat_semicategory
   ]:
   cf_proj_fst_ObjMap_app = smcf_proj_fst_ObjMap_app 
   and cf_proj_snd_ObjMap_app = smcf_proj_snd_ObjMap_app
   and cf_proj_fst_ArrMap_app = smcf_proj_fst_ArrMap_app
   and cf_proj_snd_ArrMap_app = smcf_proj_snd_ArrMap_app
 
 end
 
 
 subsubsection\<open>
 Domain and codomain of a projection of a product of two categories
 \<close>
 
 lemma cf_proj_fst_HomDom: "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
   unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def ..
 
 lemma cf_proj_fst_HomCod: "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB>\<lparr>HomCod\<rparr> = \<AA>"
   unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def by simp
   
 lemma cf_proj_snd_HomDom: "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
   unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def ..
 
 lemma cf_proj_snd_HomCod: "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB>\<lparr>HomCod\<rparr> = \<BB>"
   unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def by simp
 
 
 subsubsection\<open>Projection of a product of two categories is a functor\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemma cf_proj_fst_is_functor: 
   assumes "i \<in>\<^sub>\<circ> I" 
   shows "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   by 
     (
       rule 
         pcat_cf_proj_is_functor[
           where i=0, simplified, folded cf_proj_fst_def cat_prod_2_def
           ]
     )
 
 lemma cf_proj_fst_is_functor'[cat_cs_intros]: 
   assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = \<AA> \<times>\<^sub>C \<BB>" and "\<DD> = \<AA>"
   shows "\<pi>\<^sub>C\<^sub>.\<^sub>1 \<AA> \<BB> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1) unfolding assms(2,3) by (rule cf_proj_fst_is_functor)
 
 lemma cf_proj_snd_is_functor: 
   assumes "i \<in>\<^sub>\<circ> I" 
   shows "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   by 
     (
       rule 
         pcat_cf_proj_is_functor[
           where i=\<open>1\<^sub>\<nat>\<close>, simplified, folded cf_proj_snd_def cat_prod_2_def
           ]
     )
 
 lemma cf_proj_snd_is_functor'[cat_cs_intros]: 
   assumes "i \<in>\<^sub>\<circ> I" and "\<CC> = \<AA> \<times>\<^sub>C \<BB>" and "\<DD> = \<BB>"
   shows "\<pi>\<^sub>C\<^sub>.\<^sub>2 \<AA> \<BB> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1) unfolding assms(2,3) by (rule cf_proj_snd_is_functor)
 
 end
 
 
 
 subsection\<open>Product of three categories\<close>
 
 
 subsubsection\<open>Definition and elementary properties.\<close>
 
 definition cat_prod_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" ("(_ \<times>\<^sub>C\<^sub>3 _ \<times>\<^sub>C\<^sub>3 _)" [81, 81, 81] 80)
   where "\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i)"
 
 abbreviation cat_pow_3 :: "V \<Rightarrow> V" (\<open>_^\<^sub>C\<^sub>3\<close> [81] 80)
   where "\<CC>^\<^sub>C\<^sub>3 \<equiv> \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"
 
 
 text\<open>Slicing.\<close>
   
 lemma cat_smc_cat_prod_3[slicing_commute]: 
   "cat_smc \<AA> \<times>\<^sub>S\<^sub>M\<^sub>C\<^sub>3 cat_smc \<BB> \<times>\<^sub>S\<^sub>M\<^sub>C\<^sub>3 cat_smc \<CC> = cat_smc (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)"
   unfolding cat_prod_3_def smc_prod_3_def slicing_commute[symmetric] if_distrib
   by (simp add: if_distrib[symmetric])
 
 context 
   fixes \<alpha> \<AA> \<BB> \<CC>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)
 
 lemmas_with 
   [
     where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close> and \<CC>=\<open>cat_smc \<CC>\<close>, 
     unfolded slicing_simps slicing_commute, 
     OF \<AA>.cat_semicategory \<BB>.cat_semicategory \<CC>.cat_semicategory
   ]:
   cat_prod_3_ObjI = smc_prod_3_ObjI 
   and cat_prod_3_ObjI'[cat_prod_cs_intros] = smc_prod_3_ObjI'
   and cat_prod_3_ObjE = smc_prod_3_ObjE
   and cat_prod_3_ArrI = smc_prod_3_ArrI
   and cat_prod_3_ArrI'[cat_prod_cs_intros] = smc_prod_3_ArrI'
   and cat_prod_3_ArrE = smc_prod_3_ArrE
   and cat_prod_3_is_arrI = smc_prod_3_is_arrI
   and cat_prod_3_is_arrI'[cat_prod_cs_intros] = smc_prod_3_is_arrI'
   and cat_prod_3_is_arrE = smc_prod_3_is_arrE
   and cat_prod_3_Dom_vsv = smc_prod_3_Dom_vsv
   and cat_prod_3_Dom_vdomain[cat_cs_simps] = smc_prod_3_Dom_vdomain
   and cat_prod_3_Dom_app[cat_prod_cs_simps] = smc_prod_3_Dom_app
   and cat_prod_3_Dom_vrange = smc_prod_3_Dom_vrange
   and cat_prod_3_Cod_vsv = smc_prod_3_Cod_vsv
   and cat_prod_3_Cod_vdomain[cat_cs_simps] = smc_prod_3_Cod_vdomain
   and cat_prod_3_Cod_app[cat_prod_cs_simps] = smc_prod_3_Cod_app
   and cat_prod_3_Cod_vrange = smc_prod_3_Cod_vrange
 
 lemmas_with 
   [
     where \<AA>=\<open>cat_smc \<AA>\<close> and \<BB>=\<open>cat_smc \<BB>\<close> and \<CC>=\<open>cat_smc \<CC>\<close>, 
     unfolded slicing_simps slicing_commute, 
     OF \<AA>.cat_semicategory \<BB>.cat_semicategory \<CC>.cat_semicategory
   ]:
   cat_prod_3_Comp_app[cat_prod_cs_simps] = smc_prod_3_Comp_app
 
 end
 
 
 subsubsection\<open>Product of three categories is a category\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB> \<CC>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
 begin
 
 interpretation \<Z> \<alpha> by (rule categoryD[OF \<AA>])
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)
 
 lemma finite_pcategory_cat_prod_3: "finite_pcategory \<alpha> (3\<^sub>\<nat>) (if3 \<AA> \<BB> \<CC>)"
 proof(intro finite_pcategoryI pcategory_baseI)
   from Axiom_of_Infinity show z1_in_Vset: "3\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by blast
   show "category \<alpha> (if3 \<AA> \<BB> \<CC> i)" if "i \<in>\<^sub>\<circ> 3\<^sub>\<nat>" for i
     by (auto simp: cat_cs_intros)
 qed auto
 
 interpretation finite_pcategory \<alpha> \<open>3\<^sub>\<nat>\<close> \<open>if3 \<AA> \<BB> \<CC>\<close>
   by (intro finite_pcategory_cat_prod_3 \<AA> \<BB> \<CC>)
 
 lemma category_cat_prod_3[cat_cs_intros]: "category \<alpha> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)"
   unfolding cat_prod_3_def by (rule pcat_category_cat_prod)
 
 end
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_prod_3_CId_vsv[cat_cs_intros]: "vsv ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>)"
   unfolding cat_prod_3_def cat_prod_components by simp
 
 lemma cat_prod_3_CId_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>) = (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
   unfolding cat_prod_3_def cat_prod_components by simp
 
 context 
   fixes \<alpha> \<AA> \<BB> \<CC>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>" and \<CC>: "category \<alpha> \<CC>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 interpretation \<CC>: category \<alpha> \<CC> by (rule \<CC>)
 
 interpretation finite_pcategory \<alpha> \<open>3\<^sub>\<nat>\<close> \<open>if3 \<AA> \<BB> \<CC>\<close>
   by (intro finite_pcategory_cat_prod_3 \<AA> \<BB> \<CC>)
 
 lemma cat_prod_3_CId_app[cat_prod_cs_simps]:
   assumes "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
   shows "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>a, b, c\<rparr>\<^sub>\<bullet> = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>"
 proof-
   have "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>a, b, c\<rparr>\<^sub>\<bullet> = 
     (\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)"
     by 
       (
         rule 
           cat_prod_CId_app[
             OF assms[unfolded cat_prod_3_def], folded cat_prod_3_def
             ]
       )
   also have 
     "(\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. if3 \<AA> \<BB> \<CC> i\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>) = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>"
   proof(rule vsv_eqI, unfold vdomain_VLambda)
     fix i assume "i \<in>\<^sub>\<circ> 3\<^sub>\<nat>"
     then consider \<open>i = 0\<close> | \<open>i = 1\<^sub>\<nat>\<close> | \<open>i = 2\<^sub>\<nat>\<close> unfolding three by auto
     then show 
       "(\<lambda>i\<in>\<^sub>\<circ>3\<^sub>\<nat>. (if3 \<AA> \<BB> \<CC> i)\<lparr>CId\<rparr>\<lparr>[a, b, c]\<^sub>\<circ>\<lparr>i\<rparr>\<rparr>)\<lparr>i\<rparr> = 
         [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>]\<^sub>\<circ>\<lparr>i\<rparr>"
       by cases (simp_all add: three nat_omega_simps)
   qed (auto simp: three nat_omega_simps)
   finally show ?thesis by simp
 qed
 
 lemma cat_prod_3_CId_vrange: 
   "\<R>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
   show "vsv ((\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>)" by (rule cat_prod_3_CId_vsv)
   fix abc assume "abc \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
   then obtain a b c where abc_def: "abc = [a, b, c]\<^sub>\<circ>" 
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     by (elim cat_prod_3_ObjE[OF \<AA> \<BB> \<CC>])
   from \<AA> \<BB> \<CC> a b c show "(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>abc\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
     unfolding abc_def 
     by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
 qed
 
 end
 
 
 
 subsection\<open>
 Conversion of a product of three categories to products of two categories
 \<close>
 
 definition cf_cat_prod_21_of_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> =
     [
       (\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [[A\<lparr>0\<rparr>, A\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
       (\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [[F\<lparr>0\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>),
       \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>,
       (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>
     ]\<^sub>\<circ>"
 
 definition cf_cat_prod_12_of_3 :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> =
     [
       (\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>),
       (\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [F\<lparr>0\<rparr>, [F\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>),
       \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>,
       \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_cat_prod_21_of_3_components:
   shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr> =
     (\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [[A\<lparr>0\<rparr>, A\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
     and "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr> =
     (\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [[F\<lparr>0\<rparr>, F\<lparr>1\<^sub>\<nat>\<rparr>]\<^sub>\<circ>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>)"
     and [cat_cs_simps]: "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
     and [cat_cs_simps]: "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>HomCod\<rparr> = (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
   unfolding cf_cat_prod_21_of_3_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 lemma cf_cat_prod_12_of_3_components:
   shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr> =
     (\<lambda>A\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>. [A\<lparr>0\<rparr>, [A\<lparr>1\<^sub>\<nat>\<rparr>, A\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
     and "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr> =
     (\<lambda>F\<in>\<^sub>\<circ>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>. [F\<lparr>0\<rparr>, [F\<lparr>1\<^sub>\<nat>\<rparr>, F\<lparr>2\<^sub>\<nat>\<rparr>]\<^sub>\<circ>]\<^sub>\<circ>)"
     and [cat_cs_simps]: "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>HomDom\<rparr> = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
     and [cat_cs_simps]: "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>HomCod\<rparr> = \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
   unfolding cf_cat_prod_12_of_3_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object\<close>
 
 mk_VLambda cf_cat_prod_21_of_3_components(1)
   |vsv cf_cat_prod_21_of_3_ObjMap_vsv[cat_cs_intros]|
   |vdomain cf_cat_prod_21_of_3_ObjMap_vdomain[cat_cs_simps]|
   |app cf_cat_prod_21_of_3_ObjMap_app'|
 
 mk_VLambda cf_cat_prod_12_of_3_components(1)
   |vsv cf_cat_prod_12_of_3_ObjMap_vsv[cat_cs_intros]|
   |vdomain cf_cat_prod_12_of_3_ObjMap_vdomain[cat_cs_simps]|
   |app cf_cat_prod_12_of_3_ObjMap_app'|
 
 lemma cf_cat_prod_21_of_3_ObjMap_app[cat_cs_simps]:
   assumes "A = [a, b, c]\<^sub>\<circ>" and "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
   shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [[a, b]\<^sub>\<circ>, c]\<^sub>\<circ>"
   using assms(2) 
   unfolding assms(1)
   by (simp add: cf_cat_prod_21_of_3_ObjMap_app' nat_omega_simps)
 
 lemma cf_cat_prod_12_of_3_ObjMap_app[cat_cs_simps]:
   assumes "A = [a, b, c]\<^sub>\<circ>" and "[a, b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
   shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = [a, [b, c]\<^sub>\<circ>]\<^sub>\<circ>"
   using assms(2)
   unfolding assms(1)
   by (simp add: cf_cat_prod_12_of_3_ObjMap_app' nat_omega_simps)
 
 lemma cf_cat_prod_21_of_3_ObjMap_vrange: 
   assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
   shows "\<R>\<^sub>\<circ> (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
   show ?thesis
   proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_21_of_3_ObjMap_vdomain)
     fix A assume prems: "A \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
     then show "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
       by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_prod_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (cs_concl cs_intro: cat_cs_intros)
 qed
 
 lemma cf_cat_prod_12_of_3_ObjMap_vrange: 
   assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
   shows "\<R>\<^sub>\<circ> (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
   show ?thesis
   proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_12_of_3_ObjMap_vdomain)
     fix A assume prems: "A \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
     then show "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
       by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_prod_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (cs_concl cs_intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>Arrow\<close>
 
 mk_VLambda cf_cat_prod_21_of_3_components(2)
   |vsv cf_cat_prod_21_of_3_ArrMap_vsv[cat_cs_intros]|
   |vdomain cf_cat_prod_21_of_3_ArrMap_vdomain[cat_cs_simps]|
   |app cf_cat_prod_21_of_3_ArrMap_app'|
 
 mk_VLambda cf_cat_prod_12_of_3_components(2)
   |vsv cf_cat_prod_12_of_3_ArrMap_vsv[cat_cs_intros]|
   |vdomain cf_cat_prod_12_of_3_ArrMap_vdomain[cat_cs_simps]|
   |app cf_cat_prod_12_of_3_ArrMap_app'|
 
 lemma cf_cat_prod_21_of_3_ArrMap_app[cat_cs_simps]:
   assumes "F = [h, g, f]\<^sub>\<circ>" and "[h, g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
   shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = [[h, g]\<^sub>\<circ>, f]\<^sub>\<circ>"
   using assms(2) unfolding assms(1)
   by (simp add: cf_cat_prod_21_of_3_ArrMap_app' nat_omega_simps)
 
 lemma cf_cat_prod_12_of_3_ArrMap_app[cat_cs_simps]:
   assumes "F = [h, g, f]\<^sub>\<circ>" and "[h, g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
   shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = [h, [g, f]\<^sub>\<circ>]\<^sub>\<circ>"
   using assms(2) 
   unfolding assms(1)
   by (simp add: cf_cat_prod_12_of_3_ArrMap_app' nat_omega_simps)
 
 
 subsubsection\<open>
 Conversion of a product of three categories to products 
 of two categories is a functor
 \<close>
 
 lemma cf_cat_prod_21_of_3_is_functor:
   assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
   shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> : \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
 
   show ?thesis
   proof(rule is_functorI')
     show "vfsequence (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>)"
       unfolding cf_cat_prod_21_of_3_def by auto
     show "vcard (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>) = 4\<^sub>\<nat>"
       unfolding cf_cat_prod_21_of_3_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
       by (rule cf_cat_prod_21_of_3_ObjMap_vrange[OF assms])
     show 
       "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> : 
         cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>(\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>\<^esub> 
         cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
       if "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
       for A B F
       using that
       by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
     show 
       "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> F\<rparr> = 
         cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>(\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>\<^esub> 
         cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
       if "G : B \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
       for B C G A F
     proof- 
       from that(2) obtain f f' f'' a a' a'' b b' b''
         where F_def: "F = [f, f', f'']\<^sub>\<circ>"
           and A_def: "A = [a, a', a'']\<^sub>\<circ>"
           and B_def: "B = [b, b', b'']\<^sub>\<circ>"
           and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
           and f': "f' : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f'': "f'' : a'' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
         by (elim cat_prod_3_is_arrE[OF assms])
       with that(1) obtain g g' g'' c c' c''
         where G_def: "G = [g, g', g'']\<^sub>\<circ>"
           and C_def: "C = [c, c', c'']\<^sub>\<circ>"
           and g: "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
           and g': "g' : b' \<mapsto>\<^bsub>\<BB>\<^esub> c'"
           and g'': "g'' : b'' \<mapsto>\<^bsub>\<CC>\<^esub> c''"
         by (auto elim: cat_prod_3_is_arrE[OF assms])
       from that f f' f'' g g' g'' show ?thesis
         unfolding F_def A_def B_def G_def C_def
         by
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_prod_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show 
       "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
         ((\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>cf_cat_prod_21_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
       if "C \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>" for C
       using that 
       by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_prod_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
 
 qed
 
 lemma cf_cat_prod_21_of_3_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>" 
     and "category \<alpha> \<BB>" 
     and "category \<alpha> \<CC>"
     and "\<AA>' = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
     and "\<BB>' = (\<AA> \<times>\<^sub>C \<BB>) \<times>\<^sub>C \<CC>"
   shows "cf_cat_prod_21_of_3 \<AA> \<BB> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_21_of_3_is_functor)
 
 lemma cf_cat_prod_12_of_3_is_functor:
   assumes "category \<alpha> \<AA>" and "category \<alpha> \<BB>" and "category \<alpha> \<CC>"
   shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> : \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(3))
 
   show ?thesis
   proof(rule is_functorI')
     show "vfsequence (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>)"
       unfolding cf_cat_prod_12_of_3_def by auto
     show "vcard (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>) = 4\<^sub>\<nat>"
       unfolding cf_cat_prod_12_of_3_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>Obj\<rparr>"
       by (rule cf_cat_prod_12_of_3_ObjMap_vrange[OF assms])
     show 
       "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> :
         cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)\<^esub> 
         cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>B\<rparr>"
       if "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
       for A B F
       using that
       by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
     show 
       "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> F\<rparr> = 
         cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>G\<rparr> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)\<^esub> 
         cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
       if "G : B \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> C" and "F : A \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>\<^esub> B"
       for B C G A F
     proof- 
       from that(2) obtain f f' f'' a a' a'' b b' b''
         where F_def: "F = [f, f', f'']\<^sub>\<circ>"
           and A_def: "A = [a, a', a'']\<^sub>\<circ>"
           and B_def: "B = [b, b', b'']\<^sub>\<circ>"
           and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
           and f': "f' : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f'': "f'' : a'' \<mapsto>\<^bsub>\<CC>\<^esub> b''"
         by (elim cat_prod_3_is_arrE[OF assms])
       with that(1) obtain g g' g'' c c' c''
         where G_def: "G = [g, g', g'']\<^sub>\<circ>"
           and C_def: "C = [c, c', c'']\<^sub>\<circ>"
           and g: "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
           and g': "g' : b' \<mapsto>\<^bsub>\<BB>\<^esub> c'"
           and g'': "g'' : b'' \<mapsto>\<^bsub>\<CC>\<^esub> c''"
         by (auto elim: cat_prod_3_is_arrE[OF assms])
       from that f f' f'' g g' g'' show ?thesis
         unfolding F_def A_def B_def G_def C_def
         by
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_prod_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show 
       "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>CId\<rparr>\<lparr>C\<rparr>\<rparr> =
         (\<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>))\<lparr>CId\<rparr>\<lparr>cf_cat_prod_12_of_3 \<AA> \<BB> \<CC>\<lparr>ObjMap\<rparr>\<lparr>C\<rparr>\<rparr>"
       if "C \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>" for C
       using that 
       by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_prod_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
 
 qed
 
 lemma cf_cat_prod_12_of_3_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>" 
     and "category \<alpha> \<BB>" 
     and "category \<alpha> \<CC>"
     and "\<AA>' = \<AA> \<times>\<^sub>C\<^sub>3 \<BB> \<times>\<^sub>C\<^sub>3 \<CC>"
     and "\<BB>' = \<AA> \<times>\<^sub>C (\<BB> \<times>\<^sub>C \<CC>)"
   shows "cf_cat_prod_12_of_3 \<AA> \<BB> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_12_of_3_is_functor)
 
 
 
 subsection\<open>Bifunctors\<close>
 
 text\<open>
 A bifunctor is defined as a functor from a product of two categories
 to a category (see Chapter II-3 in \cite{mac_lane_categories_2010}).
 This subsection exposes the elementary properties of the projections of the 
 bifunctors established by fixing an argument in a functor (see Chapter II-3 
 in \cite{mac_lane_categories_2010} for further information).
 \<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 definition bifunctor_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   (\<open>(_\<^bsub>_,_\<^esub>/'(/-,_/')/\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
   where "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F =
     (\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat> -\<^sub>\<circ> set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>),\<SS>\<lparr>HomCod\<rparr>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})) \<circ>\<^sub>C\<^sub>F
       cf_singleton 0 \<AA>"
 
 definition bifunctor_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   (\<open>(_\<^bsub>_,_\<^esub>/'(/_,-/')/\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
   where "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F =
     (\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat> -\<^sub>\<circ> set {0}. (i = 0 ? \<AA> : \<BB>),\<SS>\<lparr>HomCod\<rparr>\<^esub>(-,set {\<langle>0, a\<rangle>})) \<circ>\<^sub>C\<^sub>F
       cf_singleton (1\<^sub>\<nat>) \<BB>"
 
 abbreviation bcf_ObjMap_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl "\<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<index>" 55)
   where "a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> b \<equiv> \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
 abbreviation bcf_ArrMap_app :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (infixl "\<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<index>" 55)
   where "g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f \<equiv> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
 
 
 text\<open>Elementary properties.\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemma cat_singleton_qm_fst_def[simp]: 
   "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>)) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)"
 proof(rule cat_eqI[of \<alpha>])
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Obj\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
     unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
   show [simp]: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Arr\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Arr\<rparr>"
     unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
   show [simp]: "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Dom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Dom\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
   show [simp]: 
     "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Cod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Cod\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
   have [simp]: 
     "f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>)\<^esub> b \<longleftrightarrow> 
       f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>\<^esub> b"
     for f a b
     unfolding is_arr_def by simp
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>"
   proof(rule vsv_eqI)
     show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)"
       unfolding cat_prod_components by simp
     show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>)"
       unfolding cat_prod_components by simp
     show "\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>) = 
       \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>)"
       by (simp add: composable_arrs_def cat_cs_simps)
     show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>\<lparr>gf\<rparr> = 
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Comp\<rparr>\<lparr>gf\<rparr>"
       if "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)" for gf
     proof-
       from that have "gf \<in>\<^sub>\<circ> composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))"
         by (simp add: cat_cs_simps)
       then obtain g f a b c where gf_def: "gf = [g, f]\<^sub>\<circ>" 
         and g: "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<^esub> c" 
         and f: "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<^esub> b"
         by clarsimp
       then have g': "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<^esub> c" 
         and f': "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<^esub> b"
         by simp_all
       show ?thesis
         unfolding gf_def
         unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
         by (subst (1 2) VLambda_vsingleton_def) simp
     qed
   qed
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. (i = 0 ? \<AA> : \<BB>))\<lparr>CId\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>CId\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp    
 qed 
   (
     simp_all add: 
       \<AA>.cat_category_cat_singleton
       pcategory.pcat_category_cat_prod 
       pcat_vsubset_index_pcategory 
       vsubset_vsingleton_leftI
   )
 
 lemma cat_singleton_qm_snd_def[simp]: 
   "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>)) = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)"
 proof(rule cat_eqI[of \<alpha>])
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Obj\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
     unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
   show [simp]: 
     "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Arr\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Arr\<rparr>"
     unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
   show [simp]: 
     "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Dom\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Dom\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
   show [simp]: 
     "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Cod\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Cod\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
   have [simp]: "f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>)\<^esub> b \<longleftrightarrow> 
     f : a \<mapsto>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>\<^esub> b"
     for f a b
     unfolding is_arr_def by simp
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>"
   proof(rule vsv_eqI)
     show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)"
       unfolding cat_prod_components by simp
     show "vsv ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>)"
       unfolding cat_prod_components by simp
     show "\<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>) = 
       \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>)"
       by (simp add: composable_arrs_def cat_cs_simps)
     show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>\<lparr>gf\<rparr> = 
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Comp\<rparr>\<lparr>gf\<rparr>"
       if "gf \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>Comp\<rparr>)" for gf
     proof-
       from that have "gf \<in>\<^sub>\<circ> composable_arrs (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))"
         by (simp add: cat_cs_simps)
       then obtain g f a b c where gf_def: "gf = [g, f]\<^sub>\<circ>" 
         and g: "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<^esub> c" 
         and f: "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<^esub> b"
         by clarsimp
       then have g': "g : b \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<^esub> c" 
         and f': "f : a \<mapsto>\<^bsub>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<^esub> b"
         by simp_all
       show ?thesis
         unfolding gf_def
         unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
         by (subst (1 2) VLambda_vsingleton_def) simp
     qed
   qed
   show "(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. (i = 0 ? \<AA> : \<BB>))\<lparr>CId\<rparr> = (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>CId\<rparr>"
     unfolding cat_prod_components 
     by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp    
 qed 
   (
     simp_all add: 
       \<BB>.cat_category_cat_singleton
       pcategory.pcat_category_cat_prod 
       pcat_vsubset_index_pcategory 
       vsubset_vsingleton_leftI
   )
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 context
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
   cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
 
 lemma bifunctor_proj_fst_ObjMap_app[cat_cs_simps]:
   assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
 proof-
 
   let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
   let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})\<close>
   let ?cfs = \<open>cf_singleton 0 \<AA>\<close>
 
   from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     by (all\<open>elim cat_prod_2_ObjE[OF \<AA> \<BB>]\<close>) auto
 
   from a have za: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
     by (intro cat_singleton_ObjI[where a=a]) simp
   have [simp]: "vinsert \<langle>0, a\<rangle> (set {\<langle>1\<^sub>\<nat>, b\<rangle>}) = [a, b]\<^sub>\<circ>"
     using ord_of_nat_succ_vempty unfolding vcons_def by auto
 
   have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (?\<SS>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ObjMap\<rparr>)\<lparr>a\<rparr>"
     unfolding bifunctor_proj_fst_def dghm_comp_components by simp
   also have "\<dots> = ?\<SS>\<lparr>ObjMap\<rparr>\<lparr>?cfs\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
     by (rule vsv_vcomp_at)
       (
         simp_all add:
           two a za
           cf_singleton_components 
           prodfunctor_proj_components 
           cf_singleton_ObjMap_app 
           
       ) 
   also from za have "\<dots> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>" 
     unfolding two cf_singleton_ObjMap_app[OF a] prodfunctor_proj_components 
     by simp
   finally show ?thesis by simp
 
 qed
 
 lemma bifunctor_proj_snd_ObjMap_app[cat_cs_simps]:
   assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
 proof-
 
   let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
   let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>})\<close>
   let ?cfs = \<open>cf_singleton (1\<^sub>\<nat>) \<BB>\<close>
 
   from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     by (all\<open>elim cat_prod_2_ObjE[OF \<AA> \<BB>]\<close>) auto
   from a have za: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
     by (intro cat_singleton_ObjI[where a=a]) simp
   from b have ob: "set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
     by (intro cat_singleton_ObjI[where a=b]) simp
   have[simp]: "vinsert \<langle>1\<^sub>\<nat>, b\<rangle> (set {\<langle>0, a\<rangle>}) = [a, b]\<^sub>\<circ>"
     using ord_of_nat_succ_vempty unfolding vcons_def by auto
 
   have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = (?\<SS>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ObjMap\<rparr>)\<lparr>b\<rparr>"
     unfolding bifunctor_proj_snd_def dghm_comp_components by simp
   also have "\<dots> = ?\<SS>\<lparr>ObjMap\<rparr>\<lparr>?cfs\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
     by (rule vsv_vcomp_at)
       (
         simp_all add: 
           two
           cf_singleton_components 
           prodfunctor_proj_components 
           cf_singleton_ObjMap_app 
           ob b
       ) 
   also from ob have "\<dots> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>" 
     unfolding two cf_singleton_ObjMap_app[OF b] prodfunctor_proj_components 
     by simp
   finally show ?thesis by simp
 
 qed
 
 end
 
 
 subsubsection\<open>Arrow map\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
   cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
 
 lemma bifunctor_proj_fst_ArrMap_app[cat_cs_simps]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
 proof-
 
   let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
   let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>})\<close>
   let ?cfs = \<open>cf_singleton 0 \<AA>\<close>
 
   from assms(1) have "\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr> : b \<mapsto>\<^bsub>\<BB>\<^esub> b" by (auto intro: cat_cs_intros)
   then have CId_b: "\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto
 
   from assms(2) have zf: "set {\<langle>0, f\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Arr\<rparr>"
     by (intro cat_singleton_ArrI[where a=f]) simp
   from assms(1) have ob: "set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Obj\<rparr>"
     by (intro cat_singleton_ObjI[where a=b]) simp
   have [simp]: "vinsert \<langle>0, f\<rangle> (set {\<langle>1\<^sub>\<nat>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rangle>}) = [f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>"
     using ord_of_nat_succ_vempty unfolding vcons_def by auto
 
   have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = (?\<SS>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ArrMap\<rparr>)\<lparr>f\<rparr>"
     unfolding bifunctor_proj_fst_def dghm_comp_components by simp
   also have "\<dots> = ?\<SS>\<lparr>ArrMap\<rparr>\<lparr>?cfs\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
     by (rule vsv_vcomp_at)
       (
         simp_all add:
           two
           assms(2)
           cf_singleton_components
           prodfunctor_proj_components
           cf_singleton_ArrMap_app 
           zf
       )   
   also from assms(1) zf have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>" 
     unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components 
     by (simp add: two cat_singleton_CId_app[OF ob])
   finally show ?thesis by simp
 
 qed
 
 lemma bifunctor_proj_snd_ArrMap_app[cat_cs_simps]:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "g \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
   shows "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g\<rparr>\<^sub>\<bullet>"
 proof-
 
   let ?\<DD> = \<open>\<SS>\<lparr>HomCod\<rparr>\<close>
   let ?\<SS> = \<open>\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),?\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>})\<close>
   let ?cfs = \<open>cf_singleton (1\<^sub>\<nat>) \<BB>\<close>
 
   from assms(1) have "\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> a" by (auto intro: cat_cs_intros)
   then have CId_a: "\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" by auto
 
   from assms(2) have og: "set {\<langle>1\<^sub>\<nat>, g\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<lparr>Arr\<rparr>"
     by (intro cat_singleton_ArrI[where a=g]) simp
   from assms(1) have ob: "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<lparr>Obj\<rparr>"
     by (intro cat_singleton_ObjI[where a=a]) simp
   have [simp]: "vinsert \<langle>1\<^sub>\<nat>, g\<rangle> (set {\<langle>0, \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rangle>}) = [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g]\<^sub>\<circ>"
     using ord_of_nat_succ_vempty unfolding vcons_def by auto
 
   have "(\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> = (?\<SS>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> ?cfs\<lparr>ArrMap\<rparr>)\<lparr>g\<rparr>"
     unfolding two bifunctor_proj_snd_def dghm_comp_components by simp
   also have "\<dots> = ?\<SS>\<lparr>ArrMap\<rparr>\<lparr>?cfs\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>"
     by (rule vsv_vcomp_at)
       (
         simp_all add:
           two
           assms(2) 
           cf_singleton_components 
           prodfunctor_proj_components 
           cf_singleton_ArrMap_app 
           og
       )   
   also from assms(1) og have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, g\<rparr>\<^sub>\<bullet>" 
     unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components 
     by (simp add: two cat_singleton_CId_app[OF ob])
   finally show ?thesis by simp
 
 qed
 
 end
 
 
 subsubsection\<open>Bifunctor projections are functors\<close>
 
 context 
   fixes \<alpha> \<AA> \<BB>
   assumes \<AA>: "category \<alpha> \<AA>" and \<BB>: "category \<alpha> \<BB>"
 begin
 
 interpretation \<AA>: category \<alpha> \<AA> by (rule \<AA>)
 interpretation \<BB>: category \<alpha> \<BB> by (rule \<BB>)
 
 interpretation finite_pcategory \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 \<AA> \<BB>\<close>
   by (intro finite_pcategory_cat_prod_2 \<AA> \<BB>)
 
 lemmas_with [OF \<AA>.category_axioms \<BB>.category_axioms, simp]:
   cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
 
 lemma bifunctor_proj_fst_is_functor:
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
 
   interpret \<SS>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<DD> \<SS> by (rule assms(1))
 
   show ?thesis
     unfolding bifunctor_proj_fst_def
   proof
     (
       intro cf_comp_is_functorI[where \<BB>=\<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)\<close>], 
       unfold \<SS>.cf_HomCod
     )
     from assms(2) have zb: 
       "set {\<langle>1\<^sub>\<nat>, b\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. if j = 0 then \<AA> else \<BB>)\<lparr>Obj\<rparr>"
       unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
     have o_zo: "set {1\<^sub>\<nat>} \<subseteq>\<^sub>\<circ> 2\<^sub>\<nat>" by clarsimp
     from pcat_prodfunctor_proj_is_functor[
         folded cat_prod_2_def, where J=\<open>set {1\<^sub>\<nat>}\<close>, OF assms(1) zb o_zo
         ]
     show "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {1\<^sub>\<nat>}.(i = 0 ? \<AA> : \<BB>),\<DD>\<^esub>(-,set {\<langle>1\<^sub>\<nat>, b\<rangle>}) :
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       unfolding two by simp
     from category.cat_cf_singleton_is_functor[OF \<AA>.category_axioms, of 0] show 
       "cf_singleton 0 \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {0}. \<AA>)"
       by force
   qed
 
 qed
 
 lemma bifunctor_proj_fst_is_functor'[cat_cs_intros]:
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "\<AA>' = \<AA>"
   shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_fst_is_functor)
 
 lemma bifunctor_proj_fst_ObjMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_fst_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ObjMap_vsv)
 qed
 
 lemma bifunctor_proj_fst_ObjMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_fst_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ObjMap_vdomain)
 qed
 
 lemma bifunctor_proj_fst_ArrMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_fst_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ArrMap_vsv)
 qed
 
 lemma bifunctor_proj_fst_ArrMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<AA> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_fst_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ArrMap_vdomain)
 qed
 
 lemma bifunctor_proj_snd_is_functor:
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
 
   interpret \<SS>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<DD> \<SS> by (rule assms(1))
 
   show ?thesis
     unfolding bifunctor_proj_snd_def
   proof
     (
       intro cf_comp_is_functorI[where \<BB>=\<open>(\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)\<close>], 
       unfold \<SS>.cf_HomCod
     )
     from assms(2) have zb: 
       "set {\<langle>0, a\<rangle>} \<in>\<^sub>\<circ> (\<Prod>\<^sub>Cj\<in>\<^sub>\<circ>set {0}. if j = 0 then \<AA> else \<BB>)\<lparr>Obj\<rparr>"
       unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
     have o_zo: "set {0} \<subseteq>\<^sub>\<circ> 2\<^sub>\<nat>" by clarsimp
     from 
       pcat_prodfunctor_proj_is_functor[
         folded cat_prod_2_def, where J=\<open>set {0}\<close>, OF assms(1) zb o_zo
         ]
     show "\<SS>\<^bsub>\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>2\<^sub>\<nat>-\<^sub>\<circ>set {0}.(i = 0 ? \<AA> : \<BB>),\<DD>\<^esub>(-,set {\<langle>0, a\<rangle>}) :
       (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       unfolding two by simp
     from category.cat_cf_singleton_is_functor[OF \<BB>.category_axioms, of \<open>1\<^sub>\<nat>\<close>] 
     show "cf_singleton (1\<^sub>\<nat>) \<BB> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> (\<Prod>\<^sub>Ci\<in>\<^sub>\<circ>set {1\<^sub>\<nat>}. \<BB>)"
       by force
   qed
 
 qed
 
 lemma bifunctor_proj_snd_is_functor'[cat_cs_intros]:
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "\<BB>' = \<BB>"
   shows "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_snd_is_functor)
 
 lemma bifunctor_proj_snd_ObjMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_snd_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ObjMap_vsv)
 qed
 
 lemma bifunctor_proj_snd_ObjMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_snd_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ObjMap_vdomain)
 qed
 
 lemma bifunctor_proj_snd_ArrMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "vsv ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_snd_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ArrMap_vsv)
 qed
 
 lemma bifunctor_proj_snd_ArrMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<BB> \<DD> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close>
     by (rule bifunctor_proj_snd_is_functor[OF assms])
   show ?thesis by (rule \<SS>.cf_ArrMap_vdomain)
 qed
 
 end
 
 
 
 subsection\<open>Bifunctor flip\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition bifunctor_flip :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "bifunctor_flip \<AA> \<BB> \<FF> =
     [fflip (\<FF>\<lparr>ObjMap\<rparr>), fflip (\<FF>\<lparr>ArrMap\<rparr>), \<BB> \<times>\<^sub>C \<AA>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 
 
 text\<open>Components\<close>
 
 lemma bifunctor_flip_components:
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr> = fflip (\<FF>\<lparr>ObjMap\<rparr>)"
     and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr> = fflip (\<FF>\<lparr>ArrMap\<rparr>)"
     and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<AA>"
     and "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
   unfolding bifunctor_flip_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Bifunctor flip object map\<close>
 
 lemma bifunctor_flip_ObjMap_vsv[cat_cs_intros]: 
   "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding bifunctor_flip_components by (rule fflip_vsv)
 
 lemma bifunctor_flip_ObjMap_app:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
   using assms
   unfolding bifunctor_flip_components assms(4,5)
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
 
 lemma bifunctor_flip_ObjMap_app'[cat_cs_simps]:
   assumes "ba = [b, a]\<^sub>\<circ>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
   using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ObjMap_app)
 
 lemma bifunctor_flip_ObjMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
   using assms
   unfolding bifunctor_flip_components 
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
 
 lemma bifunctor_flip_ObjMap_vrange[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
 proof-
   
   interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))
 
   show ?thesis
   proof(intro vsubset_antisym)
 
     show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
     proof
       (
         intro vsv.vsv_vrange_vsubset, 
         unfold bifunctor_flip_ObjMap_vdomain[OF assms]
       )
       fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       then obtain a b
         where ba_def: "ba = [b, a]\<^sub>\<circ>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF assms(2,1)])
       from assms a b show 
         "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
         unfolding ba_def
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
           )
     qed (auto intro: cat_cs_intros)
 
     show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
     proof(intro vsv.vsv_vrange_vsubset, unfold \<FF>.cf_ObjMap_vdomain)
       fix ab assume prems: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
       then obtain a b 
         where ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF assms(1,2)])
       from assms a b have ba: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
         by (cs_concl cs_intro: cat_prod_cs_intros)
       from assms bifunctor_flip_ObjMap_vsv prems a b ba show 
         "\<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
         by (cs_concl cs_simp: ab_def cat_cs_simps cs_intro: V_cs_intros)
     qed auto
 
   qed
 
 qed
 
 
 subsubsection\<open>Bifunctor flip arrow map\<close>
 
 lemma bifunctor_flip_ArrMap_vsv[cat_cs_intros]: 
   "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding bifunctor_flip_components by (rule fflip_vsv)
 
 lemma bifunctor_flip_ArrMap_app:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
   using assms
   unfolding bifunctor_flip_components
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
 
 lemma bifunctor_flip_ArrMap_app'[cat_cs_simps]:
   assumes "fg = [f, g]\<^sub>\<circ>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
   using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ArrMap_app)
 
 lemma bifunctor_flip_ArrMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
   using assms
   unfolding bifunctor_flip_components 
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
 
 lemma bifunctor_flip_ArrMap_vrange[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
 proof-
   
   interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))
 
   show ?thesis
   proof(intro vsubset_antisym)
 
     show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
     proof
       (
         intro vsv.vsv_vrange_vsubset, 
         unfold bifunctor_flip_ArrMap_vdomain[OF assms]
       )
       fix fg assume "fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
       then obtain f g
         where fg_def: "fg = [f, g]\<^sub>\<circ>" 
           and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
           and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
         by (elim cat_prod_2_ArrE[OF assms(2,1)])
       from f obtain a b where f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" by (auto intro: is_arrI)
       from g obtain a' b' where g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'" by (auto intro: is_arrI)
       from \<FF>.cf_ArrMap_vsv assms f g show 
         "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
         unfolding fg_def
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: V_cs_intros cat_cs_intros cat_prod_cs_intros
           )
     qed (auto intro: cat_cs_intros)
 
     show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
     proof(intro vsv.vsv_vrange_vsubset, unfold \<FF>.cf_ArrMap_vdomain)
       fix gf assume prems: "gf \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
       then obtain g f 
         where gf_def: "gf = [g, f]\<^sub>\<circ>" 
           and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
           and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
         by (elim cat_prod_2_ArrE[OF assms(1,2)])
       from assms g f have fg: "[f, g]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
         by (cs_concl cs_intro: cat_prod_cs_intros)
       from assms bifunctor_flip_ArrMap_vsv prems g f fg show 
         "\<FF>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
         unfolding gf_def
         by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
     qed auto
 
   qed
 
 qed
 
 
 subsubsection\<open>Bifunctor flip is a bifunctor\<close>
 
 lemma bifunctor_flip_is_functor:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> "
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms)
 
   show ?thesis
   proof(intro is_functorI')
     show "vfsequence (bifunctor_flip \<AA> \<BB> \<FF>)"
       unfolding bifunctor_flip_def by simp
     from assms(1,2) show "category \<alpha> (\<BB> \<times>\<^sub>C \<AA>)"
       by (cs_concl cs_intro: cat_cs_intros)
     show "vcard (bifunctor_flip \<AA> \<BB> \<FF>) = 4\<^sub>\<nat>"
       unfolding bifunctor_flip_def by (simp add: nat_omega_simps)
     show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)" by (auto intro: cat_cs_intros)
     show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)" by (auto intro: cat_cs_intros)
     from assms show "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     from assms \<FF>.cf_ObjMap_vrange show 
       "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     from assms show "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> :
       bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
       bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'a'\<rparr>"
       if "gf : ba \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> b'a'" for ba b'a' gf
     proof-
       from that obtain g f a b a' b'
         where gf_def: "gf = [g, f]\<^sub>\<circ>"
           and ba_def: "ba = [b, a]\<^sub>\<circ>"
           and b'a'_def: "b'a' = [b', a']\<^sub>\<circ>"
           and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
         by (elim cat_prod_2_is_arrE[OF assms(2,1)])
       from assms g f show ?thesis
         unfolding gf_def ba_def b'a'_def
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show 
       "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> ff'\<rparr> =
         bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> 
         bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
       if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> cc'" and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> bb'" 
       for bb' cc' gg' aa' ff'
     proof-
       obtain g g' b b' c c' 
         where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
           and cc'_def: "cc' = [c, c']\<^sub>\<circ>"   
           and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c"  
           and g': "g' : b' \<mapsto>\<^bsub>\<AA>\<^esub> c'"
         by (elim cat_prod_2_is_arrE[OF assms(2,1) gg'])
       moreover obtain f f' a a' b'' b''' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and "bb' = [b'', b''']\<^sub>\<circ>"   
           and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b''"  
           and "f' : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'''"
         by (elim cat_prod_2_is_arrE[OF assms(2,1) ff'])
       ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'" 
         by (auto simp: cat_op_simps)
       from assms g g' f f' have [cat_cs_simps]:
         "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g' \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f', g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f\<rparr>\<^sub>\<bullet> = 
           \<FF>\<lparr>ArrMap\<rparr>\<lparr>[g', g]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [f', f]\<^sub>\<circ>\<rparr>"
         by (cs_concl cs_simp: cat_prod_2_Comp_app cs_intro: cat_prod_cs_intros)
       from assms g g' f f' show 
         "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> ff'\<rparr> =
           bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
           bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
         unfolding gg'_def ff'_def (*slow*)
         by 
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps cat_cs_simps
               cs_intro: cat_prod_cs_intros cat_cs_intros
           )
     qed
     show 
       "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>(\<BB> \<times>\<^sub>C \<AA>)\<lparr>CId\<rparr>\<lparr>ba\<rparr>\<rparr> = 
         \<CC>\<lparr>CId\<rparr>\<lparr>bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr>\<rparr>"
       if "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>" for ba
     proof-
       from that obtain b a 
         where ba_def: "ba = [b, a]\<^sub>\<circ>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
       from assms b a have [cat_cs_simps]:
         "\<FF>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
           \<FF>\<lparr>ArrMap\<rparr>\<lparr>(\<AA> \<times>\<^sub>C \<BB>)\<lparr>CId\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>\<rparr>"
         by (cs_concl cs_simp: cat_prod_2_CId_app cs_intro: cat_prod_cs_intros)
       from assms b a show ?thesis
         unfolding ba_def
         by 
           (
             cs_concl 
               cs_intro: cat_cs_intros cat_prod_cs_intros 
               cs_simp: cat_prod_cs_simps cat_cs_simps
           )
     qed
   qed (auto simp: bifunctor_flip_components cat_cs_simps cat_cs_intros)
 
 qed
 
 lemma bifunctor_flip_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
   shows "bifunctor_flip \<AA> \<BB> \<FF> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1-3) unfolding assms(4) by (intro bifunctor_flip_is_functor)
 
 
 subsubsection\<open>Double-flip of a bifunctor\<close>
 
 lemma bifunctor_flip_flip[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>) = \<FF>"
 proof(rule cf_eqI)
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<FF>: is_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))
 
   from assms show 
     "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>) : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
 
   from assms have ObjMap_dom_lhs: 
     "\<D>\<^sub>\<circ> (bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr>) = 
       (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" 
     by (simp add: cat_cs_simps)
   from assms have ArrMap_dom_lhs: 
     "\<D>\<^sub>\<circ> (bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr>) =
       (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>" 
     by (simp add: cat_cs_simps)
 
   show "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
     fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
       by (rule cat_prod_2_ObjE[OF assms(1,2)])
     from assms a b show 
       "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
       unfolding ab_def
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: cat_cs_intros)
 
   show "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
     fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
       by (rule cat_prod_2_ArrE[OF assms(1,2)])
     from assms a b show 
       "bifunctor_flip \<BB> \<AA> (bifunctor_flip \<AA> \<BB> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr>"
       unfolding ab_def 
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (auto simp: cat_cs_intros)
 
 qed (simp_all add: assms(3))
 
 
 subsubsection\<open>A projection of a bifunctor flip\<close>
 
 lemma bifunctor_flip_proj_snd[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F = \<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
 proof(rule cf_eqI)
 
   from assms show f_\<FF>b: "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms show \<FF>b: "\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
 
   from assms have ObjMap_dom_lhs:
     "\<D>\<^sub>\<circ> ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   from assms have ArrMap_dom_lhs:
     "\<D>\<^sub>\<circ> ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
 
   show "(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr> = (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
     from assms show "vsv ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
       by (intro bifunctor_proj_snd_ObjMap_vsv)
         (cs_concl cs_intro: cat_cs_intros)
     from assms show "vsv ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>)"
       by (intro bifunctor_proj_fst_ObjMap_vsv)
         (cs_concl cs_intro: cat_cs_intros)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = 
         (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
   qed simp
 
   show 
     "(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr> = (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
     from assms show "vsv ((bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
       by (intro bifunctor_proj_snd_ArrMap_vsv)
         (cs_concl cs_intro: cat_cs_intros)
     from assms show "vsv ((\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>)"
       by (intro bifunctor_proj_fst_ArrMap_vsv)
         (cs_concl cs_intro: cat_cs_intros)
     fix f assume "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     with assms show 
       "(bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         (\<FF>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed simp
 
 qed simp_all
 
 lemma bifunctor_flip_proj_fst[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "bifunctor_flip \<AA> \<BB> \<FF>\<^bsub>\<BB>,\<AA>\<^esub>(-,a)\<^sub>C\<^sub>F = \<FF>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
 proof-
   from assms have f_\<FF>: "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   show ?thesis
     by 
       (
         rule 
           bifunctor_flip_proj_snd
             [
               OF assms(2,1) f_\<FF> assms(4), 
               unfolded bifunctor_flip_flip[OF assms(1,2,3)],
               symmetric
             ]
       )
 qed
 
 
 subsubsection\<open>A flip of a bifunctor isomorphism\<close>
 
 lemma bifunctor_flip_is_iso_functor:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<FF> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC> "
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<FF>: is_iso_functor \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<FF> by (rule assms(3))
 
   from assms have f_\<FF>: "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> "
     by (cs_concl cs_intro: cat_cs_intros)
 
   from f_\<FF> have ObjMap_dom: 
     "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>" 
     by (cs_concl cs_simp: cat_cs_simps)
   from f_\<FF> have ArrMap_dom: 
     "\<D>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>" 
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(intro is_iso_functorI' vsv.vsv_valeq_v11I, unfold ObjMap_dom ArrMap_dom)
     from assms show "bifunctor_flip \<AA> \<BB> \<FF> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     fix ba b'a'
     assume prems: 
       "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       "b'a' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'a'\<rparr>"
     from prems(1) obtain b a
       where ba_def: "ba = [b, a]\<^sub>\<circ>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
       by (elim cat_prod_2_ObjE[OF assms(2,1)])
     from prems(2) obtain a' b'
       where b'a'_def: "b'a' = [b', a']\<^sub>\<circ>" 
         and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
       by (rule cat_prod_2_ObjE[OF assms(2,1)])
     from prems(3) assms a b b' a' have \<FF>ab_\<FF>a'b': 
       "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet>"
       unfolding ba_def b'a'_def
       by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
     from assms a b a' b' have "[a, b]\<^sub>\<circ> = [a', b']\<^sub>\<circ>"
       by 
         (
           cs_concl 
             cs_intro: 
               \<FF>.ObjMap.v11_eq_iff[THEN iffD1, OF _ _ \<FF>ab_\<FF>a'b'] 
               cat_prod_cs_intros
         )
     then show "ba = b'a'" unfolding ba_def b'a'_def by simp
   next
     fix fg f'g' assume prems:
       "fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
       "f'g' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>" 
       "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f'g'\<rparr>"
     from prems(1) obtain f g
       where fg_def: "fg = [f, g]\<^sub>\<circ>" 
         and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
         and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
       by (elim cat_prod_2_ArrE[OF assms(2,1)])
     from prems(2) obtain f' g'
       where f'g'_def: "f'g' = [f', g']\<^sub>\<circ>" 
         and f': "f' \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
         and g': "g' \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
       by (rule cat_prod_2_ArrE[OF assms(2,1)])
     from prems(3) assms f g f' g' have \<FF>gf_\<FF>g'f': 
       "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g', f'\<rparr>\<^sub>\<bullet>"
       unfolding fg_def f'g'_def
       by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
     from assms g f g' f' have "[g, f]\<^sub>\<circ> = [g', f']\<^sub>\<circ>"
       by 
         (
           cs_concl 
             cs_simp: 
             cs_intro:
               \<FF>.ArrMap.v11_eq_iff[THEN iffD1, OF _ _ \<FF>gf_\<FF>g'f'] 
               cat_prod_cs_intros
         )
     then show "fg = f'g'" unfolding fg_def f'g'_def by simp
   next
     
     show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
     proof(rule vsubset_antisym)
       show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       proof(rule vsv.vsv_vrange_vsubset, unfold ObjMap_dom)
         fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
         then obtain b a
           where ba_def: "ba = [b, a]\<^sub>\<circ>" 
             and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
             and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           by (elim cat_prod_2_ObjE[OF assms(2,1)])
         from assms b a show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
           unfolding ba_def 
           by (cs_concl cs_intro: cat_cs_intros cf_cs_intros cat_prod_cs_intros)
       qed (auto simp: cat_cs_intros)
       show "\<CC>\<lparr>Obj\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
       proof(intro vsubsetI)
         fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         from prems obtain ab 
           where ab: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" and \<FF>ab: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> = c"
           by blast
         from ab obtain b a
           where ab_def: "ab = [a, b]\<^sub>\<circ>" 
             and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
             and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           by (elim cat_prod_2_ObjE[OF assms(1,2)])
         show "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>)"
         proof(intro vsv.vsv_vimageI2', unfold ObjMap_dom)
           from assms a b show "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
             by (cs_concl cs_intro: cat_prod_cs_intros)
           from assms b a prems show "c = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet>"
             by 
               (
                 cs_concl 
                   cs_simp: \<FF>ab[unfolded ab_def] cat_cs_simps
                   cs_intro: cf_cs_intros
               )
         qed (auto intro: cat_cs_intros)
       qed
     qed
 
     show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
     proof(rule vsubset_antisym)
       show "\<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
       proof(rule vsv.vsv_vrange_vsubset, unfold ArrMap_dom)
         show "vsv (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)" by (auto intro: cat_cs_intros)
         fix fg assume "fg \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
         then obtain f g
           where fg_def: "fg = [f, g]\<^sub>\<circ>" 
             and f: "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
             and g: "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
           by (elim cat_prod_2_ArrE[OF assms(2,1)])
         from g f obtain a b a' b' 
           where f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"
           by (auto intro!: is_arrI)
         from assms f g show "bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>fg\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
           by (cs_concl cs_simp: fg_def cs_intro: cat_cs_intros cat_prod_cs_intros)
       qed
       show "\<CC>\<lparr>Arr\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
       proof(intro vsubsetI)
         fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
         from prems obtain ab 
           where ab: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>" and \<FF>ab: "\<FF>\<lparr>ArrMap\<rparr>\<lparr>ab\<rparr> = c"
           by blast
         from ab obtain b a
           where ab_def: "ab = [a, b]\<^sub>\<circ>" 
             and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
             and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
           by (elim cat_prod_2_ArrE[OF assms(1,2)])
         show "c \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>)"
         proof(intro vsv.vsv_vimageI2', unfold ArrMap_dom)
           from assms a b show "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
             by (cs_concl cs_intro: cat_prod_cs_intros)
           from assms b a prems show "c = bifunctor_flip \<AA> \<BB> \<FF>\<lparr>ArrMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet>"
             by 
               (
                 cs_concl 
                   cs_simp: \<FF>ab[unfolded ab_def] cat_cs_simps 
                   cs_intro: cat_cs_intros 
               )
         qed (auto intro: cat_cs_intros)
       qed
     qed
 
   qed (auto intro: cat_cs_intros)
 
 qed
 
 
 
 subsection\<open>Array bifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_array :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> =
     [
       (\<lambda>a\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<GG> (vpfst a)\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>),
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
           \<GG> (\<BB>\<lparr>Cod\<rparr>\<lparr>vpfst f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
           \<FF> (\<CC>\<lparr>Dom\<rparr>\<lparr>vpsnd f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>
       ),
       \<BB> \<times>\<^sub>C \<CC>,
       \<DD>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_array_components:
   shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr> =
     (\<lambda>a\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<GG> (vpfst a)\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>)"
     and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr> =
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
           \<GG> (\<BB>\<lparr>Cod\<rparr>\<lparr>vpfst f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub>
           \<FF> (\<CC>\<lparr>Dom\<rparr>\<lparr>vpsnd f\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>
       )"
     and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<CC>"
     and "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<DD>"
   unfolding cf_array_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_array_ObjMap_vsv: "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
   unfolding cf_array_components by simp
 
 lemma cf_array_ObjMap_vdomain[cat_cs_simps]:
   "\<D>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   unfolding cf_array_components by simp
 
 lemma cf_array_ObjMap_app[cat_cs_simps]:
   assumes "[b, c]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
   using assms unfolding cf_array_components by (simp add: nat_omega_simps)
 
 lemma cf_array_ObjMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "category \<alpha> \<CC>"
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ObjMap_vdomain)
   show "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>)" by (rule cf_array_ObjMap_vsv)
   fix x assume prems: "x \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   then obtain b c where x_def: "x = [b, c]\<^sub>\<circ>" 
     and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     by (elim cat_prod_2_ObjE[OF assms(1,2)])
   interpret \<GG>b: is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b\<close> by (rule assms(3)[OF b])
   from prems c show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
     unfolding x_def cf_array_components 
     by (auto simp: nat_omega_simps cat_cs_intros)
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_array_ArrMap_vsv: "vsv (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>)"
   unfolding cf_array_components by simp
 
 lemma cf_array_ArrMap_vdomain[cat_cs_simps]:
   "\<D>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
   unfolding cf_array_components by simp
 
 lemma cf_array_ArrMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<BB>"
     and "category \<alpha> \<CC>"
     and "g : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
     and "f : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
   shows "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> = 
     \<GG> b\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
 proof-
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   from cat_prod_2_is_arrI[OF assms] have "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>" by auto
   with assms show ?thesis
     unfolding cf_array_components by (simp add: nat_omega_simps cat_cs_simps)
 qed
 
 lemma cf_array_ArrMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "category \<alpha> \<CC>"
     and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and [cat_cs_simps]: 
       "\<And>b c. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ArrMap_vdomain)
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   interpret \<BB>\<CC>: category \<alpha> \<open>\<BB> \<times>\<^sub>C \<CC>\<close> 
     by (simp add: \<BB>.category_axioms \<CC>.category_axioms category_cat_prod_2)
   fix gf assume prems: "gf \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
   then obtain bc b'c' where gf: "gf : bc \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> b'c'" by auto
   then obtain g f b c b' c'
     where gf_def: "gf = [g, f]\<^sub>\<circ>" 
       and "bc = [b, c]\<^sub>\<circ>" 
       and "b'c' = [b', c']\<^sub>\<circ>"
       and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'" 
       and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
     by (elim cat_prod_2_is_arrE[OF assms(1,2)])
   then have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     by auto
   interpret \<GG>b: is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b\<close> by (rule assms(4)[OF b])
   interpret \<FF>c: is_functor \<alpha> \<BB> \<DD> \<open>\<FF> c\<close> by (rule assms(3)[OF c])
   interpret \<GG>b': is_functor \<alpha> \<CC> \<DD> \<open>\<GG> b'\<close> by (rule assms(4)[OF b'])
   interpret \<FF>c': is_functor \<alpha> \<BB> \<DD> \<open>\<FF> c'\<close> by (rule assms(3)[OF c'])
   from 
     \<GG>b.is_functor_axioms 
     \<FF>c.is_functor_axioms 
     \<GG>b'.is_functor_axioms 
     \<FF>c'.is_functor_axioms 
     \<GG>b.HomCod.category_axioms 
     g f
   have "\<GG> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   with g f prems show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
     unfolding gf_def cf_array_components 
     by (simp add: nat_omega_simps cat_cs_simps)
 qed (simp add: cf_array_ArrMap_vsv)
 
 
 subsubsection\<open>Array bifunctor is a bifunctor\<close>
 
 lemma cf_array_specification:
   \<comment>\<open>See Proposition 1 from Chapter II-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "category \<alpha> \<BB>"
     and "category \<alpha> \<CC>"
     and "category \<alpha> \<DD>"
     and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<FF> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<And>b c. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and 
       "\<And>b c b' c' f g. \<lbrakk> f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'; g : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<rbrakk> \<Longrightarrow>
         \<GG> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
           \<FF> c'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> b\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
   shows cf_array_is_functor: "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and cf_array_ObjMap_app_fst: "\<And>b c. \<lbrakk> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and cf_array_ObjMap_app_snd: "\<And>b c. \<lbrakk> b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     and cf_array_ArrMap_app_fst: "\<And>a b f c. \<lbrakk> f : a \<mapsto>\<^bsub>\<BB>\<^esub> b; c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>\<rbrakk> \<Longrightarrow>
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     and cf_array_ArrMap_app_snd: "\<And>a b g c. \<lbrakk> g : a \<mapsto>\<^bsub>\<CC>\<^esub> b; c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, g\<rparr>\<^sub>\<bullet> = \<GG> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
 proof-
 
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(1))
   interpret \<CC>: category \<alpha> \<CC> by (rule assms(2))
   interpret \<DD>: category \<alpha> \<DD> by (rule assms(3))
 
   from assms(4) have [cat_cs_intros]: "\<FF> c : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<DD>'" 
     if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "\<BB>' = \<BB>" "\<DD>' = \<DD>" "\<alpha>' = \<alpha>" for \<alpha>' c \<BB>' \<DD>'
     using that(1) unfolding that(2-4) by (intro assms(4))
   from assms(4) have [cat_cs_intros]: "\<GG> c : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<DD>'" 
     if "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" "\<CC>' = \<CC>" "\<DD>' = \<DD>" "\<alpha>' = \<alpha>" for \<alpha>' c \<CC>' \<DD>'
     using that(1) unfolding that(2-4) by (intro assms(5))
 
   show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   proof(intro is_functorI')
     show "vfsequence (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>)" unfolding cf_array_def by auto
     from assms(1,2) show "category \<alpha> (\<BB> \<times>\<^sub>C \<CC>)"
       by (simp add: category_cat_prod_2)
     show "vcard (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>) = 4\<^sub>\<nat>"
       unfolding cf_array_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
       by (rule cf_array_ObjMap_vrange) (auto simp: assms intro: cat_cs_intros)
     show cf_array_is_arrI: "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
       if ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> bb'" for aa' bb' ff'
     proof-
       obtain f f' a a' b b' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"  
           and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'"
         by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms ff'])
       then have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and a': "a' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
         and b': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by auto
       from f' assms(5)[OF a] a have
         "\<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
       with assms(1-3) f f' assms(4)[OF b'] show ?thesis
         unfolding ff'_def aa'_def bb'_def
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps assms(6) 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> ff'\<rparr> = 
       cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
       if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> cc'" and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> bb'" 
       for bb' cc' gg' aa' ff'
     proof-
       obtain g g' b b' c c' 
         where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
           and cc'_def: "cc' = [c, c']\<^sub>\<circ>"   
           and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c"  
           and g': "g' : b' \<mapsto>\<^bsub>\<CC>\<^esub> c'"
         by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms gg'])
       moreover obtain f f' a a' b'' b''' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and "bb' = [b'', b''']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b''"  
           and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'''"
         by (elim cat_prod_2_is_arrE[OF \<BB>.category_axioms \<CC>.category_axioms ff'])
       ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b'" by auto
       with g have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and a': "a' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
         and b': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         and c': "b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by auto
       from f' assms(5)[OF a] a have \<GG>a_f':
         "\<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
       from f' b assms(5)[OF b] have \<GG>b_f': 
         "\<GG> b\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
       from f' c assms(5)[OF c] have \<GG>c_f':
         "\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> : \<FF> a'\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> \<FF> b'\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
         by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
       have
         "\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>) = 
           (\<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>) \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
         using f' f g \<GG>b_f' assms(4)[OF a'] assms(4)[OF b'] 
         by (cs_concl cs_simp: cat_cs_simps assms(7) cs_intro: cat_cs_intros)
       also have "\<dots> =
         \<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
         using assms(2) f f' g g' assms(4)[OF a'] assms(5)[OF c]
         by (cs_concl cs_simp: assms(6) cat_cs_simps cs_intro: cat_cs_intros)
       finally have [cat_cs_simps]:
         "\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> b'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<GG> a\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>) =
           \<GG> c\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> (\<FF> a'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> \<FF> a'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
         by simp
       show ?thesis
         using 
           \<GG>a_f' \<GG>c_f'
           f f' 
           g g'
           assms(1,2)  
           assms(4)[OF a'] 
           assms(4)[OF c']
           assms(5)[OF c]
         unfolding gg'_def ff'_def aa'_def bb'_def cc'_def (*slow*)
         by 
           (
             cs_concl
               cs_simp: assms(6,7) cat_prod_cs_simps cat_cs_simps 
               cs_intro: cat_prod_cs_intros cat_cs_intros
           )
     qed
     show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(\<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> = 
       \<DD>\<lparr>CId\<rparr>\<lparr>cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
       if "cc' \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for cc'
     proof-
       from that obtain c c' 
         where cc'_def: "cc' = [c, c']\<^sub>\<circ>" 
           and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
       from assms(1,2,3) c c' assms(4)[OF c'] assms(5)[OF c] show ?thesis
         unfolding cc'_def (*very slow*)
         by 
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps cat_cs_simps assms(6) 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
   qed (auto simp: cf_array_components cat_cs_intros)
 
-  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr> \<lparr>b, c\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
+  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for b c
     using that assms(1,2,3)
     by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_prod_cs_intros)
-  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr> \<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
+  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = \<GG> b\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for b c 
     using that assms(1,2,3)
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
-  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr> \<lparr>f, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
+  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet> = \<FF> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     if f: "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a b f c
   proof-
     from f have "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
     from assms(5)[OF this(1)] assms(5)[OF this(2)] assms(4)[OF c] show ?thesis
       using assms(1,2,3) f c 
       by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_cs_intros)
   qed
 
-  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr> \<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, g\<rparr>\<^sub>\<bullet> = \<GG> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
+  show "cf_array \<BB> \<CC> \<DD> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>, g\<rparr>\<^sub>\<bullet> = \<GG> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
     if g: "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and c: "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for a b g c
   proof-
     from g have "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
     from assms(4)[OF this(1)] assms(4)[OF this(2)] assms(5)[OF c] show ?thesis
       using assms(1,2,3) g c
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps assms(6)[symmetric] cs_intro: cat_cs_intros
         )
   qed
 
 qed
 
 
 
 subsection\<open>Composition of a covariant bifunctor and covariant functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties.\<close>
 
 definition cf_bcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_bcomp \<SS> \<FF> \<GG> =
     [
       (
         \<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
           \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
       ),
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
       ),
       \<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>,
       \<SS>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_bcomp_components:
   shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr> = 
       (
         \<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
           \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
       )"
     and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr> = 
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
       )"
     and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
     and "cf_bcomp \<SS> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_bcomp_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_bcomp_ObjMap_vsv: "vsv (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
   unfolding cf_bcomp_components by simp
 
 lemma cf_bcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms)
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms)
   show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
 qed
 
 lemma cf_bcomp_ObjMap_app[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
   shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   from assms show ?thesis 
     unfolding cf_bcomp_components 
     by (simp_all add: cat_cs_simps nat_omega_simps)
 qed
 
 lemma cf_bcomp_ObjMap_vrange:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
 proof
   (
     rule vsv.vsv_vrange_vsubset, 
     unfold cf_bcomp_ObjMap_vdomain[OF assms(1,2)]
   )
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   show "vsv (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)" by (rule cf_bcomp_ObjMap_vsv)
   fix bc assume "bc \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
   with \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms obtain b c 
     where bc_def: "bc = [b, c]\<^sub>\<circ>" and b: "b \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>" and c: "c \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
     by (elim cat_prod_2_ObjE[rotated -1])  
   from assms b c show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bc\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
     unfolding bc_def 
     by 
       (
         cs_concl
           cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_bcomp_ArrMap_vsv: "vsv (cf_bcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding cf_bcomp_components by simp
 
 lemma cf_bcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
 qed
 
 lemma cf_bcomp_ArrMap_app[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
   shows "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>\<^sub>\<bullet>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   from assms show ?thesis 
     unfolding cf_bcomp_components by (simp_all add: nat_omega_simps cat_cs_simps)
 qed
 
 lemma cf_bcomp_ArrMap_vrange:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cf_bcomp_ArrMap_vdomain[OF assms(1,2)])
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   fix gf assume "gf \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
   with \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms obtain g f
     where gf_def: "gf = [g, f]\<^sub>\<circ>" and g: "g \<in>\<^sub>\<circ> \<BB>'\<lparr>Arr\<rparr>" and f: "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
     by (elim cat_prod_2_ArrE[rotated -1])  
   from g obtain a b where g: "g : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" by auto
   from f obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
   from assms g f show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
     unfolding gf_def 
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed (simp add: cf_bcomp_ArrMap_vsv)
 
 
 subsubsection\<open>
 Composition of a covariant bifunctor and 
 covariant functors is a functor
 \<close>
 
 lemma cf_bcomp_is_functor:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_bcomp \<SS> \<FF> \<GG> : \<BB>' \<times>\<^sub>C \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
 
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   interpret \<SS>: is_functor \<alpha> \<open>\<BB> \<times>\<^sub>C \<CC>\<close> \<DD> \<SS> by (rule assms(3))
 
   show ?thesis
   proof(intro is_functorI')
     show "vfsequence (cf_bcomp \<SS> \<FF> \<GG>)" unfolding cf_bcomp_def by simp
     show "category \<alpha> (\<BB>' \<times>\<^sub>C \<CC>')"
       by 
         (
           simp add: 
             \<FF>.HomDom.category_axioms  
             \<GG>.HomDom.category_axioms 
             category_cat_prod_2
         )
     show "vcard (cf_bcomp \<SS> \<FF> \<GG>) = 4\<^sub>\<nat>"
       unfolding cf_bcomp_def by (simp add: nat_omega_simps)
     from assms show "\<R>\<^sub>\<circ> (cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
       by (rule cf_bcomp_ObjMap_vrange)
     show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
       cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub> cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
     if ff': "ff' : aa' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'" for aa' bb' ff'
     proof-
       obtain f f' a a' b b' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b"  
           and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'"
         by 
           (
             elim 
               cat_prod_2_is_arrE[
                 OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms ff'
                 ]
           )
       from assms f f' show ?thesis
         unfolding ff'_def aa'_def bb'_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> ff'\<rparr> =
       cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
       if gg': "gg' : bb' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> cc'" 
         and ff': "ff' : aa' \<mapsto>\<^bsub>\<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'"
       for bb' cc' gg' aa' ff'
     proof-
       obtain g g' b b' c c' 
         where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
           and cc'_def: "cc' = [c, c']\<^sub>\<circ>"   
           and g: "g : b \<mapsto>\<^bsub>\<BB>'\<^esub> c"  
           and g': "g' : b' \<mapsto>\<^bsub>\<CC>'\<^esub> c'"
         by 
           (
             elim cat_prod_2_is_arrE[
               OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms gg'
               ]
           )
       moreover obtain f f' a a' b'' b''' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and "bb' = [b'', b''']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b''"  
           and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'''"
         by 
           (
             elim cat_prod_2_is_arrE[
               OF \<FF>.HomDom.category_axioms \<GG>.HomDom.category_axioms ff'
               ]
           )
       ultimately have f: "f : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
       from assms f f' g g' have [cat_cs_simps]:
         "[\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ> = 
           [\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<BB> \<times>\<^sub>C \<CC>\<^esub> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ>"
         by 
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
       from assms f f' g g' show ?thesis
         unfolding gg'_def ff'_def aa'_def bb'_def cc'_def
         by
           (
             cs_concl
               cs_simp: cat_prod_cs_simps cat_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show 
       "cf_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(\<BB>' \<times>\<^sub>C \<CC>')\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> = 
         \<DD>\<lparr>CId\<rparr>\<lparr>cf_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
       if "cc' \<in>\<^sub>\<circ> (\<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>" for cc'
     proof-
       from that obtain c c' 
         where cc'_def: "cc' = [c, c']\<^sub>\<circ>" 
           and c: "c \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>"
           and c': "c' \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
       from assms c c' have [cat_cs_simps]: 
         "[\<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>]\<^sub>\<circ> = 
           (\<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>\<^sub>\<bullet>"
         by
           (
             cs_concl
               cs_simp: cat_prod_cs_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
       from assms c c' show ?thesis
         unfolding cc'_def
         by
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps cat_cs_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
   qed (auto simp: cf_bcomp_components cat_cs_intros cat_cs_simps)
 
 qed
 
 lemma cf_bcomp_is_functor'[cat_cs_intros]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA>' =  \<BB>' \<times>\<^sub>C \<CC>'"
   shows "cf_bcomp \<SS> \<FF> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_bcomp_is_functor)
 
 
 
 subsection\<open>Composition of a contracovariant bifunctor and covariant functors\<close>
 
 text\<open>
 The term \<open>contracovariant bifunctor\<close> is used to refer to a bifunctor
 that is contravariant in the first argument and covariant in the second
 argument.
 \<close>
 
 definition cf_cn_cov_bcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_cn_cov_bcomp \<SS> \<FF> \<GG> =
     [
       (
         \<lambda>a\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
           \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
       ),
       (
         \<lambda>f\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
       ),
       op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>,
       \<SS>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_cn_cov_bcomp_components:
   shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr> =
       (
         \<lambda>a\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
           \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>vpfst a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>vpsnd a\<rparr>\<rparr>\<^sub>\<bullet>
       )"
     and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr> =
       (
         \<lambda>f\<in>\<^sub>\<circ>(op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>)\<lparr>Arr\<rparr>.
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>vpfst f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>vpsnd f\<rparr>\<rparr>\<^sub>\<bullet>
       )"
     and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
     and "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_cn_cov_bcomp_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_cn_cov_bcomp_ObjMap_vsv: "vsv (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)"
   unfolding cf_cn_cov_bcomp_components by simp
 
 lemma cf_cn_cov_bcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) = (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   show ?thesis 
     unfolding cf_cn_cov_bcomp_components 
     by (simp add: nat_omega_simps cat_cs_simps)
 qed
 
 lemma cf_cn_cov_bcomp_ObjMap_app[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
   shows 
     "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> =
       \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   from assms show ?thesis 
     unfolding cf_cn_cov_bcomp_components 
     by (simp_all add: cat_cs_simps nat_omega_simps)
 qed
 
 lemma cf_cn_cov_bcomp_ObjMap_vrange:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
 proof
   (
     rule vsv.vsv_vrange_vsubset, 
     unfold cf_cn_cov_bcomp_ObjMap_vdomain[OF assms(1,2)]
   )
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   show "vsv (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>)" 
     by (rule cf_cn_cov_bcomp_ObjMap_vsv)
   fix bc assume "bc \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>"
   with \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms obtain b c 
     where bc_def: "bc = [b, c]\<^sub>\<circ>" 
       and b: "b \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Obj\<rparr>" 
       and c: "c \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
     by (elim cat_prod_2_ObjE[rotated -1])  
   from assms b c show "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bc\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
     unfolding bc_def cat_op_simps
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps 
           cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_cn_cov_bcomp_ArrMap_vsv: "vsv (cf_cn_cov_bcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding cf_cn_cov_bcomp_components by simp
 
 lemma cf_cn_cov_bcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) = (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   show ?thesis unfolding cf_cn_cov_bcomp_components by (simp add: cat_cs_simps)
 qed
 
 lemma cf_cn_cov_bcomp_ArrMap_app[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "[g, f]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
   shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
     \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>\<^sub>\<bullet>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   from assms show ?thesis 
     unfolding cf_cn_cov_bcomp_components 
     by (simp_all add: nat_omega_simps cat_cs_simps)
 qed
 
 lemma cf_cn_cov_bcomp_ArrMap_vrange:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold cf_cn_cov_bcomp_ArrMap_vdomain[OF assms(1,2)])
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   fix gf assume "gf \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Arr\<rparr>"
   with \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms obtain g f
     where gf_def: "gf = [g, f]\<^sub>\<circ>" 
       and g: "g \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Arr\<rparr>" 
       and f: "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
     by (elim cat_prod_2_ArrE[rotated -1])  
   from g obtain a b where g: "g : a \<mapsto>\<^bsub>\<BB>'\<^esub> b" unfolding cat_op_simps by auto
   from f obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by auto
   from assms g f show "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<in>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
     unfolding gf_def 
     by
       (
         cs_concl
           cs_simp: cat_cs_simps 
           cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
       )
 qed (rule cf_cn_cov_bcomp_ArrMap_vsv)
 
 
 subsubsection\<open>
 Composition of a contracovariant bifunctor and functors is a functor
 \<close>
 
 lemma cf_cn_cov_bcomp_is_functor:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG> : op_cat \<BB>' \<times>\<^sub>C \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
 
   interpret \<FF>: is_functor \<alpha> \<BB>' \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC>' \<CC> \<GG> by (rule assms(2))
   interpret \<SS>: is_functor \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<DD> \<SS> by (rule assms(3))
 
   show ?thesis
   proof(intro is_functorI')
     show "vfsequence (cf_cn_cov_bcomp \<SS> \<FF> \<GG>)" 
       unfolding cf_cn_cov_bcomp_def by simp
     show "category \<alpha> (op_cat \<BB>' \<times>\<^sub>C \<CC>')"
       by 
         (
           simp add: 
             \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms category_cat_prod_2
         )
     show "vcard (cf_cn_cov_bcomp \<SS> \<FF> \<GG>) = 4\<^sub>\<nat>"
       unfolding cf_cn_cov_bcomp_def by (simp add: nat_omega_simps)
     from assms show "\<R>\<^sub>\<circ> (cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
       by (rule cf_cn_cov_bcomp_ObjMap_vrange)
     show 
       "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr> :
         cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>aa'\<rparr> \<mapsto>\<^bsub>\<DD>\<^esub>
         cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>bb'\<rparr>"
       if ff': "ff' : aa' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'" for aa' bb' ff'
     proof-
       obtain f f' a a' b b' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b"  
           and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'"
         by 
           (
             elim 
               cat_prod_2_is_arrE[
                 OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms ff'
                 ]
           )
       from assms f f' show ?thesis
         unfolding ff'_def aa'_def bb'_def cat_op_simps
         by (*slow*)
           (
             cs_concl
               cs_simp: cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed
     show 
       "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg' \<circ>\<^sub>A\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> ff'\<rparr> =
         cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>gg'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> 
         cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>ff'\<rparr>"
       if gg': "gg' : bb' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> cc'" 
         and ff': "ff' : aa' \<mapsto>\<^bsub>op_cat \<BB>' \<times>\<^sub>C \<CC>'\<^esub> bb'"
       for bb' cc' gg' aa' ff'
     proof-
       obtain g g' b b' c c' 
         where gg'_def: "gg' = [g, g']\<^sub>\<circ>"
           and bb'_def: "bb' = [b, b']\<^sub>\<circ>"
           and cc'_def: "cc' = [c, c']\<^sub>\<circ>"   
           and g: "g : b \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> c"  
           and g': "g' : b' \<mapsto>\<^bsub>\<CC>'\<^esub> c'"
         by 
           (
             elim cat_prod_2_is_arrE[
               OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms gg'
               ]
           )
       moreover obtain f f' a a' b'' b''' 
         where ff'_def: "ff' = [f, f']\<^sub>\<circ>"
           and aa'_def: "aa' = [a, a']\<^sub>\<circ>"
           and "bb' = [b'', b''']\<^sub>\<circ>"   
           and f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b''"  
           and "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'''"
         by 
           (
             elim cat_prod_2_is_arrE[
               OF \<FF>.HomDom.category_op \<GG>.HomDom.category_axioms ff'
               ]
           )
       ultimately have f: "f : a \<mapsto>\<^bsub>op_cat \<BB>'\<^esub> b" and f': "f' : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" 
         by auto
       from assms f f' g g' have [cat_cs_simps]:
         "[
           \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, 
           \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>
          ]\<^sub>\<circ> = 
           [\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>op_cat \<BB> \<times>\<^sub>C \<CC>\<^esub> 
           [\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>]\<^sub>\<circ>"
         unfolding cat_op_simps
         by 
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       from assms f f' g g' show ?thesis
         unfolding gg'_def ff'_def aa'_def bb'_def cc'_def cat_op_simps
         by
           (
             cs_concl
               cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed
     show 
       "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ArrMap\<rparr>\<lparr>(op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>CId\<rparr>\<lparr>cc'\<rparr>\<rparr> = 
         \<DD>\<lparr>CId\<rparr>\<lparr>cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<lparr>ObjMap\<rparr>\<lparr>cc'\<rparr>\<rparr>"
       if "cc' \<in>\<^sub>\<circ> (op_cat \<BB>' \<times>\<^sub>C \<CC>')\<lparr>Obj\<rparr>" for cc'
     proof-
       from that obtain c c' 
         where cc'_def: "cc' = [c, c']\<^sub>\<circ>" 
           and c: "c \<in>\<^sub>\<circ> op_cat \<BB>'\<lparr>Obj\<rparr>"
           and c': "c' \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[rotated 2]) 
           (auto intro: cat_cs_intros)
       from assms c c' have [cat_cs_simps]: 
         "[\<BB>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>, \<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>]\<^sub>\<circ> =
           (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>, \<GG>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>\<rparr>\<^sub>\<bullet>"
         unfolding cat_op_simps
         by 
           (
             cs_concl
               cs_simp: cat_prod_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       from assms c c' show ?thesis
         unfolding cc'_def cat_op_simps
         by (*slow*)
           (
             cs_concl 
               cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed
   qed (auto simp: cf_cn_cov_bcomp_components cat_cs_simps intro: cat_cs_intros)
 
 qed
 
 lemma cf_cn_cov_bcomp_is_functor'[cat_cs_intros]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA>' = op_cat \<BB>' \<times>\<^sub>C \<CC>'"
   shows "cf_cn_cov_bcomp \<SS> \<FF> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_bcomp_is_functor)
 
 
 subsubsection\<open>Projection of a contracovariant bifunctor and functors\<close>
 
 lemma cf_cn_cov_bcomp_bifunctor_proj_snd[cat_cs_simps]:
   assumes "\<FF> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "b \<in>\<^sub>\<circ> \<BB>'\<lparr>Obj\<rparr>"
   shows
     "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F =
       (\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>"
 proof(rule cf_eqI)
   from assms show [intro]: 
     "cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     "(\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG> : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms have ObjMap_dom_lhs:
     "\<D>\<^sub>\<circ> ((cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>) = \<CC>'\<lparr>Obj\<rparr>"
     and ObjMap_dom_rhs:
     "\<D>\<^sub>\<circ> (((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>) = \<CC>'\<lparr>Obj\<rparr>"
     and ArrMap_dom_lhs:
     "\<D>\<^sub>\<circ> ((cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>) = \<CC>'\<lparr>Arr\<rparr>"
     and ArrMap_dom_rhs:
     "\<D>\<^sub>\<circ> (((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>) = \<CC>'\<lparr>Arr\<rparr>"
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros cs_simp: cat_cs_simps)+
   show 
     "(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr> =
       ((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> \<CC>'\<lparr>Obj\<rparr>"
     with assms show 
       "(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> =
         ((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_prod_cs_simps cat_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed (auto intro: is_functor.cf_ObjMap_vsv) 
   show 
     "(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr> =
       ((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
     fix f assume "f \<in>\<^sub>\<circ> \<CC>'\<lparr>Arr\<rparr>"
     then obtain a' b' where "f : a' \<mapsto>\<^bsub>\<CC>'\<^esub> b'" by (auto intro: is_arrI)
     with assms show 
       "(cf_cn_cov_bcomp \<SS> \<FF> \<GG>\<^bsub>op_cat \<BB>',\<CC>'\<^esub>(b,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         ((\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps cat_op_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed (auto intro: is_functor.cf_ArrMap_vsv) 
 qed simp_all
 
 
 
 subsection\<open>Composition of a covariant bifunctor and a covariant functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition cf_lcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_lcomp \<CC> \<SS> \<FF> = cf_bcomp \<SS> \<FF> (cf_id \<CC>)"
 
 definition cf_rcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_rcomp \<BB> \<SS> \<GG> = cf_bcomp \<SS> (cf_id \<BB>) \<GG>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_lcomp_components:
   shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr> \<times>\<^sub>C \<CC>"
     and "cf_lcomp \<CC> \<SS> \<FF>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_lcomp_def cf_bcomp_components dghm_id_components by simp_all
 
 lemma cf_rcomp_components:
   shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>HomDom\<rparr> = \<BB> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
     and "cf_rcomp \<BB> \<SS> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_rcomp_def cf_bcomp_components dghm_id_components by simp_all
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_lcomp_ObjMap_vsv: "vsv (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding cf_lcomp_def by (rule cf_bcomp_ObjMap_vsv)
 
 lemma cf_rcomp_ObjMap_vsv: "vsv (cf_rcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding cf_rcomp_def by (rule cf_bcomp_ObjMap_vsv)
 
 lemma cf_lcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) = (\<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   using assms 
   unfolding cf_lcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_rcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
   using assms 
   unfolding cf_rcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_lcomp_ObjMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, c\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, c\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_lcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
 
 lemma cf_rcomp_ObjMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b, \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_rcomp_def
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
 
 lemma cf_lcomp_ObjMap_vrange:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
   using assms
   unfolding cf_lcomp_def 
   by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_rcomp_ObjMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
   using assms
   unfolding cf_rcomp_def 
   by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_lcomp_ArrMap_vsv: "vsv (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding cf_lcomp_def by (rule cf_bcomp_ArrMap_vsv)
 
 lemma cf_rcomp_ArrMap_vsv: "vsv (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>)"
   unfolding cf_rcomp_def by (rule cf_bcomp_ArrMap_vsv)
 
 lemma cf_lcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) = (\<AA> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
   using assms 
   unfolding cf_lcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_rcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
   using assms 
   unfolding cf_rcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_lcomp_ArrMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
     and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   shows "cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, g\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_lcomp_def
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
 
 lemma cf_rcomp_ArrMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
     and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_rcomp_def
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
 
 lemma cf_lcomp_ArrMap_vrange:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
   using assms
   unfolding cf_lcomp_def
   by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_rcomp_ArrMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
   using assms
   unfolding cf_rcomp_def
   by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 
 
 subsubsection\<open>
 Composition of a covariant bifunctor and a covariant functor is a functor
 \<close>
 
 lemma cf_lcomp_is_functor:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_lcomp \<CC> \<SS> \<FF> : \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms
   unfolding cf_lcomp_def
   by (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_lcomp_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA>' = \<AA> \<times>\<^sub>C \<CC>"
   shows "cf_lcomp \<CC> \<SS> \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_lcomp_is_functor)
 
 lemma cf_rcomp_is_functor:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_rcomp \<BB> \<SS> \<GG> : \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms 
   unfolding cf_rcomp_def 
   by (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_rcomp_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA>' = \<BB> \<times>\<^sub>C \<AA>"
   shows "cf_rcomp \<BB> \<SS> \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_rcomp_is_functor)
 
 
 
 subsection\<open>Composition of a contracovariant bifunctor and a covariant functor\<close>
 
 definition cf_cn_cov_lcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_cn_cov_lcomp \<CC> \<SS> \<FF> = cf_cn_cov_bcomp \<SS> \<FF> (cf_id \<CC>)"
 
 definition cf_cn_cov_rcomp :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_cn_cov_rcomp \<BB> \<SS> \<GG> = cf_cn_cov_bcomp \<SS> (cf_id \<BB>) \<GG>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_cn_cov_lcomp_components:
   shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomDom\<rparr>) \<times>\<^sub>C \<CC>"
     and "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_cn_cov_lcomp_def cf_cn_cov_bcomp_components dghm_id_components 
   by simp_all
 
 lemma cf_cn_cov_rcomp_components:
   shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>HomDom\<rparr> = op_cat \<BB> \<times>\<^sub>C \<GG>\<lparr>HomDom\<rparr>"
     and "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>HomCod\<rparr> = \<SS>\<lparr>HomCod\<rparr>"
   unfolding cf_cn_cov_rcomp_def cf_cn_cov_bcomp_components dghm_id_components 
   by simp_all
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_cn_cov_lcomp_ObjMap_vsv: "vsv (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)
 
 lemma cf_cn_cov_rcomp_ObjMap_vsv: "vsv (cf_cn_cov_rcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)
 
 lemma cf_cn_cov_lcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   using assms 
   unfolding cf_cn_cov_lcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_cn_cov_rcomp_ObjMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) = (op_cat \<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
   using assms 
   unfolding cf_cn_cov_rcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_cn_cov_lcomp_ObjMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a, c\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>, c\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_cn_cov_lcomp_def cat_op_simps
   by
     (
       cs_concl
         cs_simp: cat_cs_simps cat_op_simps 
         cs_intro: cat_cs_intros cat_prod_cs_intros
     )
 
 lemma cf_cn_cov_rcomp_ObjMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ObjMap\<rparr>\<lparr>b, \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_cn_cov_rcomp_def cat_op_simps
   by
     (
       cs_concl
         cs_simp: cat_cs_simps cat_op_simps 
         cs_intro: cat_cs_intros cat_prod_cs_intros
     )
 
 lemma cf_cn_cov_lcomp_ObjMap_vrange:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
   using assms
   unfolding cf_cn_cov_lcomp_def 
   by (intro cf_cn_cov_bcomp_ObjMap_vrange) 
     (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_cn_cov_rcomp_ObjMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
   using assms
   unfolding cf_cn_cov_rcomp_def 
   by (intro cf_cn_cov_bcomp_ObjMap_vrange) 
     (cs_concl cs_intro: cat_cs_intros)+
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_cn_cov_lcomp_ArrMap_vsv: "vsv (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)
 
 lemma cf_cn_cov_rcomp_ArrMap_vsv: "vsv (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>)"
   unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)
 
 lemma cf_cn_cov_lcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
   using assms 
   unfolding cf_cn_cov_lcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_cn_cov_rcomp_ArrMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) = (op_cat \<BB> \<times>\<^sub>C \<AA>)\<lparr>Arr\<rparr>"
   using assms 
   unfolding cf_cn_cov_rcomp_def 
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_cn_cov_lcomp_ArrMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "f \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Arr\<rparr>" 
     and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>, g\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_cn_cov_lcomp_def cat_op_simps
   by 
     (
       cs_concl 
         cs_simp: cat_cs_simps cat_op_simps 
         cs_intro: cat_cs_intros cat_prod_cs_intros
     )
 
 lemma cf_cn_cov_rcomp_ArrMap_app[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Arr\<rparr>" 
     and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f, g\<rparr>\<^sub>\<bullet> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>f, \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<rparr>\<^sub>\<bullet>"
   using assms 
   unfolding cf_cn_cov_rcomp_def cat_op_simps
   by 
     (
       cs_concl 
         cs_simp: cat_cs_simps cat_op_simps
         cs_intro: cat_cs_intros cat_prod_cs_intros
     )
 
 lemma cf_cn_cov_lcomp_ArrMap_vrange:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
   using assms
   unfolding cf_cn_cov_lcomp_def
   by (intro cf_cn_cov_bcomp_ArrMap_vrange) 
     (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_cn_cov_rcomp_ArrMap_vrange:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "\<R>\<^sub>\<circ> (cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<DD>\<lparr>Arr\<rparr>"
   using assms
   unfolding cf_cn_cov_rcomp_def cat_op_simps
   by (intro cf_cn_cov_bcomp_ArrMap_vrange) 
     (cs_concl cs_intro: cat_cs_intros)+
 
 
 subsubsection\<open>
 Composition of a contracovariant bifunctor and a covariant functor is a functor
 \<close>
 
 lemma cf_cn_cov_lcomp_is_functor:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF> : op_cat \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms
   unfolding cf_cn_cov_lcomp_def cat_op_simps
   by (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_cn_cov_lcomp_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA>\<CC> = op_cat \<AA> \<times>\<^sub>C \<CC>"
   shows "cf_cn_cov_lcomp \<CC> \<SS> \<FF> : \<AA>\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_lcomp_is_functor)
 
 lemma cf_cn_cov_rcomp_is_functor:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG> : op_cat \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms
   unfolding cf_cn_cov_rcomp_def cat_op_simps
   by (cs_concl cs_intro: cat_cs_intros)+
 
 lemma cf_cn_cov_rcomp_is_functor'[cat_cs_intros]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<BB>\<AA> = op_cat \<BB> \<times>\<^sub>C \<AA>"
   shows "cf_cn_cov_rcomp \<BB> \<SS> \<GG> : \<BB>\<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_rcomp_is_functor)
 
 
 subsubsection\<open>
 Projection of a composition of a contracovariant bifunctor and a covariant 
 functor
 \<close>
 
 lemma cf_cn_cov_rcomp_bifunctor_proj_snd[cat_cs_simps]:
   assumes "category \<alpha> \<BB>" 
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows
     "cf_cn_cov_rcomp \<BB> \<SS> \<GG>\<^bsub>op_cat \<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F =
       (\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F) \<circ>\<^sub>C\<^sub>F \<GG>"
   using assms 
   unfolding cf_cn_cov_rcomp_def
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemma cf_cn_cov_lcomp_bifunctor_proj_snd[cat_cs_simps]:
   assumes "category \<alpha> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<SS> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows
     "cf_cn_cov_lcomp \<CC> \<SS> \<FF>\<^bsub>op_cat \<AA>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F =
       (\<SS>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<^sub>C\<^sub>F)"
   using assms 
   unfolding cf_cn_cov_lcomp_def
   by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
 
 
 
 subsection\<open>Composition of bifunctors\<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 definition cf_blcomp :: "V \<Rightarrow> V"
   where "cf_blcomp \<SS> = 
     cf_lcomp (\<SS>\<lparr>HomCod\<rparr>) \<SS> \<SS> \<circ>\<^sub>C\<^sub>F  
     cf_cat_prod_21_of_3 (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>)"
 
 definition cf_brcomp :: "V \<Rightarrow> V"
   where "cf_brcomp \<SS> = 
     cf_rcomp (\<SS>\<lparr>HomCod\<rparr>) \<SS> \<SS> \<circ>\<^sub>C\<^sub>F
     cf_cat_prod_12_of_3 (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>) (\<SS>\<lparr>HomCod\<rparr>)"
 
 
 text\<open>Alternative forms of the definitions.\<close>
 
 lemma cf_blcomp_def':
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "cf_blcomp \<SS> = cf_lcomp \<CC> \<SS> \<SS> \<circ>\<^sub>C\<^sub>F cf_cat_prod_21_of_3 \<CC> \<CC> \<CC>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   show ?thesis
     by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def cs_intro: cat_cs_intros)
 qed
 
 lemma cf_brcomp_def':
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "cf_brcomp \<SS> = cf_rcomp \<CC> \<SS> \<SS> \<circ>\<^sub>C\<^sub>F cf_cat_prod_12_of_3 \<CC> \<CC> \<CC>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   show ?thesis
     by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def cs_intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>Compositions of bifunctors are functors\<close>
 
 lemma cf_blcomp_is_functor:
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "cf_blcomp \<SS> : \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   show ?thesis
     by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def' cs_intro: cat_cs_intros)
 qed
 
 lemma cf_blcomp_is_functor'[cat_cs_intros]:
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<AA>' = \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"
   shows "cf_blcomp \<SS> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1) unfolding assms(2) by (rule cf_blcomp_is_functor)
 
 lemma cf_brcomp_is_functor:
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "cf_brcomp \<SS> : \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   show ?thesis
     by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def' cs_intro: cat_cs_intros)
 qed
 
 lemma cf_brcomp_is_functor'[cat_cs_intros]:
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<AA>' = \<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>"
   shows "cf_brcomp \<SS> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1) unfolding assms(2) by (rule cf_brcomp_is_functor)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_blcomp_ObjMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "vsv (cf_blcomp \<SS>\<lparr>ObjMap\<rparr>)"
 proof-
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms])
   show ?thesis by auto
 qed
 
 lemma cf_brcomp_ObjMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "vsv (cf_brcomp \<SS>\<lparr>ObjMap\<rparr>)"
 proof-
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms])
   show ?thesis by auto
 qed
  
 lemma cf_blcomp_ObjMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_blcomp \<SS>\<lparr>ObjMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms])
   show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma cf_brcomp_ObjMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_brcomp \<SS>\<lparr>ObjMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms])
   show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma cf_blcomp_ObjMap_app[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "A = [a, b, c]\<^sub>\<circ>"
     and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "cf_blcomp \<SS>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = (a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> b) \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> c"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms(1)])
   from assms(3-5) show ?thesis
     unfolding assms(2)
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def' 
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 lemma cf_brcomp_ObjMap_app[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "A = [a, b, c]\<^sub>\<circ>"
     and "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "cf_brcomp \<SS>\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> = a \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> (b \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>O\<^bsub>\<SS>\<^esub> c)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms(1)])
   from assms(3-5) show ?thesis
     unfolding assms(2)
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_blcomp_ArrMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "vsv (cf_blcomp \<SS>\<lparr>ArrMap\<rparr>)"
 proof-
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms])
   show ?thesis by auto
 qed
 
 lemma cf_brcomp_ArrMap_vsv[cat_cs_intros]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "vsv (cf_brcomp \<SS>\<lparr>ArrMap\<rparr>)"
 proof-
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms])
   show ?thesis by auto
 qed
  
 lemma cf_blcomp_ArrMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_blcomp \<SS>\<lparr>ArrMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms])
   show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma cf_brcomp_ArrMap_vdomain[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> (cf_brcomp \<SS>\<lparr>ArrMap\<rparr>) = (\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>)\<lparr>Arr\<rparr>"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms])
   show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma cf_blcomp_ArrMap_app[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "F = [h, g, f]\<^sub>\<circ>"
     and "h \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
     and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
     and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   shows "cf_blcomp \<SS>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = (h \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> g) \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_blcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_blcomp \<SS>\<close>
     by (rule cf_blcomp_is_functor[OF assms(1)])
   from assms(3-5) show ?thesis
     unfolding assms(2)
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def' 
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 lemma cf_brcomp_ArrMap_app[cat_cs_simps]: 
   assumes "\<SS> : \<CC> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "F = [h, g, f]\<^sub>\<circ>"
     and "h \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
     and "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
     and "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   shows "cf_brcomp \<SS>\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> = h \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> (g \<otimes>\<^sub>H\<^sub>M\<^sub>.\<^sub>A\<^bsub>\<SS>\<^esub> f)"
 proof-
   interpret \<SS>: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C \<CC>\<close> \<CC> \<SS> by (rule assms)
   interpret cf_brcomp: is_functor \<alpha> \<open>\<CC> \<times>\<^sub>C\<^sub>3 \<CC> \<times>\<^sub>C\<^sub>3 \<CC>\<close> \<CC> \<open>cf_brcomp \<SS>\<close>
     by (rule cf_brcomp_is_functor[OF assms(1)])
   from assms(3-5) show ?thesis
     unfolding assms(2)
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 
 
 subsection\<open>Binatural transformation\<close>
 
 
 subsubsection\<open>Definitions and elementary properties\<close>
 
 text\<open>
 In this work, a \<open>binatural transformation\<close> is used to denote a natural 
 transformation of bifunctors.
 \<close>
 
 definition bnt_proj_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   (\<open>(_\<^bsub>_,_\<^esub>/'(/-,_/')/\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
   where "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>),
       \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F,
       \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F,
       \<AA>,
       \<NN>\<lparr>NTDGCod\<rparr>
     ]\<^sub>\<circ>"
 
 definition bnt_proj_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   (\<open>(_\<^bsub>_,_\<^esub>/'(/_,-/')/\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<close> [51, 51, 51, 51] 51)
   where "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F =
     [
       (\<lambda>b\<in>\<^sub>\<circ>\<BB>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>),
       \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F,
       \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F,
       \<BB>,
       \<NN>\<lparr>NTDGCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components\<close>
 
 lemma bnt_proj_fst_components:
   shows "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGDom\<rparr> = \<AA>"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
   unfolding bnt_proj_fst_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 lemma bnt_proj_snd_components:
   shows "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<lambda>b\<in>\<^sub>\<circ>\<BB>\<lparr>Obj\<rparr>. \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGDom\<rparr> = \<BB>"
     and "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
   unfolding bnt_proj_snd_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation maps\<close>
 
 mk_VLambda bnt_proj_fst_components(1)[folded VLambda_vconst_on]
   |vsv bnt_proj_fst_NTMap_vsv[cat_cs_intros]|
   |vdomain bnt_proj_fst_NTMap_vdomain[cat_cs_simps]|
   |app bnt_proj_fst_NTMap_app[cat_cs_simps]|
 
 lemma bnt_proj_fst_vrange:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
   show ?thesis
     unfolding bnt_proj_fst_components
   proof(rule vrange_VLambda_vsubset)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"    
     with assms show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
       by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
   qed
 qed
 
 mk_VLambda bnt_proj_snd_components(1)[folded VLambda_vconst_on]
   |vsv bnt_proj_snd_NTMap_vsv[intro]|
   |vdomain bnt_proj_snd_NTMap_vdomain[cat_cs_simps]|
   |app bnt_proj_snd_NTMap_app[cat_cs_simps]|
 
 lemma bnt_proj_snd_vrange:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
   show ?thesis
     unfolding bnt_proj_snd_components
   proof(rule vrange_VLambda_vsubset)
     fix b assume "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"    
     with assms show "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
       by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
   qed
 qed
 
 
 subsubsection\<open>Binatural transformation projection is a natural transformation\<close>
 
 lemma bnt_proj_snd_is_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
   show ?thesis
   proof(intro is_ntcfI')
     show "vfsequence (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)" unfolding bnt_proj_snd_def by simp 
     show "vcard (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F) = 5\<^sub>\<nat>"
       unfolding bnt_proj_snd_def by (simp add: nat_omega_simps)
     from assms show "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms show "\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
       (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
       using that assms 
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
         )
     show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
       (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
       if "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b" for a' b f
       using that assms 
       by 
         (
           cs_concl 
             cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (auto simp: bnt_proj_snd_components cat_cs_simps)
 qed
 
 lemma bnt_proj_snd_is_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
     and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms by (auto intro: bnt_proj_snd_is_ntcf)
 
 lemma bnt_proj_fst_is_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
   show ?thesis
   proof(intro is_ntcfI')
     show "vfsequence (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)" unfolding bnt_proj_fst_def by simp 
     show "vcard (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F) = 5\<^sub>\<nat>"
       unfolding bnt_proj_fst_def by (simp add: nat_omega_simps)
     from assms show "\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA>  \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     from assms show "\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
       (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
       using that assms 
       by
         (
           cs_concl
             cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
         )
     show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
       (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b'" for a b' f
       using that assms 
       by
         (
           cs_concl
             cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps 
             cs_intro: cat_cs_intros cat_prod_cs_intros
         )
   qed (auto simp: bnt_proj_fst_components cat_cs_simps)
 qed
 
 lemma bnt_proj_fst_is_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "\<AA>' = \<AA>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1-4) unfolding assms(5-7) by (rule bnt_proj_fst_is_ntcf)
 
 
 subsubsection\<open>Array binatural transformation is a natural transformation\<close>
 
 lemma ntcf_array_is_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<SS> : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "vfsequence \<NN>"
     and "vcard \<NN> = 5\<^sub>\<nat>"
     and "\<NN>\<lparr>NTDom\<rparr> = \<SS>"
     and "\<NN>\<lparr>NTCod\<rparr> = \<SS>'"
     and "\<NN>\<lparr>NTDGDom\<rparr> = \<AA> \<times>\<^sub>C \<BB>"
     and "\<NN>\<lparr>NTDGCod\<rparr> = \<CC>"
     and "vsv (\<NN>\<lparr>NTMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
     and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
       \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow>
       \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"  
   shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<NN>: vsv \<open>\<NN>\<lparr>NTMap\<rparr>\<close> by (rule assms(11))  
 
   have [cat_cs_intros]:
     "\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>; A = \<SS>\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>; B = \<SS>'\<lparr>ObjMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> \<rbrakk> \<Longrightarrow>
       \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> : A \<mapsto>\<^bsub>\<CC>\<^esub> B"
     for a b A B
     by (auto intro: assms(13))
 
   show ?thesis
   proof(intro is_ntcfI')
 
     show "\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
       if "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab
     proof-
       from that obtain a b 
         where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF assms(1,2)])
       from a b show ?thesis unfolding ab_def by (rule assms(13))
     qed
     
     show
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>a'b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> = \<SS>'\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
       if "gf : ab \<mapsto>\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> a'b'" for ab a'b' gf
     proof-
       from that obtain g f a b a' b'
         where gf_def: "gf = [g, f]\<^sub>\<circ>" 
           and ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a'b'_def: "a'b' = [a', b']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
           and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
         by (elim cat_prod_2_is_arrE[OF assms(1,2)])
       then have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         and a': "a' \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
         by auto
       show ?thesis
         unfolding gf_def ab_def a'b'_def
       proof-
         from is_ntcfD'(13)[OF assms(15)[OF b] g] g f assms(1,2,3,4) 
         have [cat_cs_simps]:
           "(\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>) =
             (\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>)"
           by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
         from is_ntcfD'(13)[OF assms(14)[OF a'] f] g f assms(1,2) 
         have \<SS>'\<NN>:
           "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> =
             \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet>"
           by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
         from g f assms(1-4) have [cat_cs_simps]: 
           "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) =
             \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q)"
           if "q : r \<mapsto>\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ObjMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet>" for q r
           using that
           by
             (
               cs_concl
                 cs_simp: \<SS>'\<NN> category.cat_Comp_assoc[symmetric]  
                 cs_intro: cat_cs_intros cat_prod_cs_intros
             ) 
 
         from assms(1-4) g f have 
           "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
             \<SS>'\<lparr>ArrMap\<rparr>\<lparr>[\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<rparr>"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
             ) 
-        also from assms(1-4) g f have "\<dots> = \<SS>'\<lparr>ArrMap\<rparr> \<lparr>g, f\<rparr>\<^sub>\<bullet>"
+        also from assms(1-4) g f have "\<dots> = \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cat_prod_cs_simps
                 cs_intro: cat_cs_intros cat_prod_cs_intros
             )
-        finally have \<SS>'_gf: "\<SS>'\<lparr>ArrMap\<rparr> \<lparr>g, f\<rparr>\<^sub>\<bullet> =
+        finally have \<SS>'_gf: "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
           \<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
           by simp
         from assms(1-4) g f have 
           "\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet> =
             \<SS>\<lparr>ArrMap\<rparr>\<lparr>[\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>\<AA> \<times>\<^sub>C \<BB>\<^esub> [g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>]\<^sub>\<circ>\<rparr>"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
             ) 
-        also from assms(1-4) g f have "\<dots> = \<SS>\<lparr>ArrMap\<rparr> \<lparr>g, f\<rparr>\<^sub>\<bullet>"
+        also from assms(1-4) g f have "\<dots> = \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cat_prod_cs_simps
                 cs_intro: cat_cs_intros cat_prod_cs_intros
             )
         finally have \<SS>_gf: "\<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
           \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
           by simp
         from assms(1-4) g f assms(13)[OF a b] assms(13)[OF a' b] have 
           "\<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> =
             (\<SS>'\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b\<rparr>\<^sub>\<bullet>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
             \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
           unfolding \<SS>'_gf 
           by
             (
               cs_concl
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
             )
         also from assms(1-4) g f have 
           "\<dots> = (\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
             \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>"
           by
             (
               cs_concl
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
             )
         also from assms(1-4) g f assms(13)[OF a' b'] have 
           "\<dots> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
             (\<SS>\<lparr>ArrMap\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>a'\<rparr>,f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, \<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>\<^sub>\<bullet>)"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
             )
         also from assms(1-4) g f assms(13)[OF a' b'] have 
           "\<dots> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>"
           unfolding \<SS>_gf[symmetric] by simp
         finally show 
           "\<NN>\<lparr>NTMap\<rparr>\<lparr>a', b'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<SS>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
             \<SS>'\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
           by simp
       qed
     qed
 
   qed (auto simp: assms)
 
 qed
 
 
 subsubsection\<open>Binatural transformation projections and isomorphisms\<close>
 
 lemma is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<And>a. a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow> 
       \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   show ?thesis  
   proof(intro is_iso_ntcfI)
     show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
     fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b 
       where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by (elim cat_prod_2_ObjE[OF assms(1,2)])
     interpret \<NN>a: is_iso_ntcf 
       \<alpha> \<BB> \<CC> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close> \<open>\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F\<close> \<open>\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close>
       by (rule assms(4)[OF a])
     from b have \<NN>ab: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     from \<NN>a.iso_ntcf_is_arr_isomorphism[OF b] assms(1,2,3) a b show
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>" 
       by (cs_prems cs_simp: cat_cs_simps ab_def cs_intro: cat_prod_cs_intros)
   qed
 qed
 
 lemma is_iso_ntcf_if_bnt_proj_fst_is_iso_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow>
       \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
 proof-
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   show ?thesis  
   proof(intro is_iso_ntcfI)
     show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
     fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b 
       where ab_def: "ab = [a, b]\<^sub>\<circ>" and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by (elim cat_prod_2_ObjE[OF assms(1,2)])
     interpret \<NN>a: is_iso_ntcf 
       \<alpha> \<AA> \<CC> \<open>\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close> \<open>\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F\<close> \<open>\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<close>
       by (rule assms(4)[OF b])
     from b have \<NN>ab: "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from \<NN>a.iso_ntcf_is_arr_isomorphism[OF a] assms(1,2,3) a b show
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> : \<SS>\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
       unfolding ab_def 
       by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
   qed
 qed
 
 lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_iso_ntcfI)
   from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
     (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     using assms that 
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
       )
 qed
 
 lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
     and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>C\<^sub>F"
     and "\<BB>' = \<BB>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   unfolding assms(4-6) 
   by (rule bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])
 
 lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_iso_ntcfI)
   from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   show "(\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
     (\<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> (\<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
     using assms that 
     by
       (
         cs_concl
           cs_simp: cat_cs_simps
           cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
       )
 qed
 
 lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<FF> = \<SS>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "\<GG> = \<SS>'\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>C\<^sub>F"
     and "\<AA>' = \<AA>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   unfolding assms(4-6) 
   by (rule bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])
 
 
 
 subsection\<open>Binatural transformation flip\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition bnt_flip :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "bnt_flip \<AA> \<BB> \<NN> =
     [
       fflip (\<NN>\<lparr>NTMap\<rparr>), 
       bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>),
       bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>),
       \<BB> \<times>\<^sub>C \<AA>,
       \<NN>\<lparr>NTDGCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma bnt_flip_components:
   shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr> = fflip (\<NN>\<lparr>NTMap\<rparr>)"
     and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDom\<rparr> = bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTDom\<rparr>)"
     and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTCod\<rparr> = bifunctor_flip \<AA> \<BB> (\<NN>\<lparr>NTCod\<rparr>)"
     and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDGDom\<rparr> = \<BB> \<times>\<^sub>C \<AA>"
     and "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTDGCod\<rparr> = \<NN>\<lparr>NTDGCod\<rparr>"
   unfolding bnt_flip_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 context 
   fixes \<alpha> \<AA> \<BB> \<CC> \<SS> \<SS>' \<NN>
   assumes \<NN>: "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule \<NN>)
 
 lemmas bnt_flip_components' = 
   bnt_flip_components[where \<AA>=\<AA> and \<BB>=\<BB> and \<NN>=\<NN>, unfolded cat_cs_simps]
 
 lemmas [cat_cs_simps] = bnt_flip_components'(2-5)
 
 end
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma bnt_flip_NTMap_vsv[cat_cs_intros]: "vsv (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
   unfolding bnt_flip_components by (rule fflip_vsv)
 
 lemma bnt_flip_NTMap_app:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>b, a\<rparr>\<^sub>\<bullet> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
   using assms
   unfolding bnt_flip_components
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
 
 lemma bnt_flip_NTMap_app'[cat_cs_simps]:
   assumes "ba = [b, a]\<^sub>\<circ>"
     and "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
   using assms(2-6) unfolding assms(1) by (rule bnt_flip_NTMap_app)
 
 lemma bnt_flip_NTMap_vdomain[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<D>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) = (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
   using assms
   unfolding bnt_flip_components
   by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
 
 lemma bnt_flip_NTMap_vrange[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) = \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
 proof-
   
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
 
   show ?thesis
   proof(intro vsubset_antisym)
 
     show "\<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
     proof
       (
         intro vsv.vsv_vrange_vsubset, 
         unfold bnt_flip_NTMap_vdomain[OF assms]
       )
       fix ba assume "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
       then obtain a b
         where ba_def: "ba = [b, a]\<^sub>\<circ>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF assms(2,1)])
       from \<NN>.ntcf_NTMap_vsv assms a b show 
         "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>)"
         unfolding ba_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
           )
     qed (cs_concl cs_intro: cat_cs_intros)
 
     show "\<R>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
     proof(intro vsv.vsv_vrange_vsubset, unfold \<NN>.ntcf_NTMap_vdomain)
       fix ab assume prems: "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
       then obtain a b 
         where ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[OF assms(1,2)])
       from assms a b have ba: "[b, a]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>"
         by (cs_concl cs_intro: cat_prod_cs_intros)
       from assms bnt_flip_NTMap_vsv prems a b ba show 
         "\<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>)"
         unfolding ab_def 
         by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
     qed auto
 
   qed
 
 qed
 
 
 subsubsection\<open>Binatural transformation flip natural transformation map\<close>
 
 lemma bnt_flip_NTMap_is_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "bnt_flip \<AA> \<BB> \<NN> : 
     bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' : 
     \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
 
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
 
   show ?thesis
   proof(intro is_ntcfI')
     show "vfsequence (bnt_flip \<AA> \<BB> \<NN>)" unfolding bnt_flip_def by simp
     show "vcard (bnt_flip \<AA> \<BB> \<NN>) = 5\<^sub>\<nat>"
       unfolding bnt_flip_def by (simp add: nat_omega_simps)
     show "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr> :
       bifunctor_flip \<AA> \<BB> \<SS>\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
       bifunctor_flip \<AA> \<BB> \<SS>'\<lparr>ObjMap\<rparr>\<lparr>ba\<rparr>"
       if "ba \<in>\<^sub>\<circ> (\<BB> \<times>\<^sub>C \<AA>)\<lparr>Obj\<rparr>" for ba
     proof-
       from that obtain b a 
         where ba_def: "ba = [b, a]\<^sub>\<circ>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
       from assms a b show ?thesis 
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps ba_def 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
     show 
       "bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>b'a'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bifunctor_flip \<AA> \<BB> \<SS>\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> =
         bifunctor_flip \<AA> \<BB> \<SS>'\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> bnt_flip \<AA> \<BB> \<NN>\<lparr>NTMap\<rparr>\<lparr>ba\<rparr>"
       if "gf : ba \<mapsto>\<^bsub>\<BB> \<times>\<^sub>C \<AA>\<^esub> b'a'" for ba b'a' gf
     proof-
       from that obtain g f a b a' b'
         where gf_def: "gf = [g, f]\<^sub>\<circ>"
           and ba_def: "ba = [b, a]\<^sub>\<circ>"
           and b'a'_def: "b'a' = [b', a']\<^sub>\<circ>"
           and g: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> a'"
         by (elim cat_prod_2_is_arrE[OF assms(2,1)])
       from assms g f show ?thesis
         unfolding gf_def ba_def b'a'_def
         by 
           ( 
             cs_concl 
               cs_simp: cat_cs_simps cat_cs_simps \<NN>.ntcf_Comp_commute
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
     qed
 
   qed (use assms in \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>)+
 
 qed
 
 lemma bnt_flip_NTMap_is_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<T> = bifunctor_flip \<AA> \<BB> \<SS>"
     and "\<T>' = bifunctor_flip \<AA> \<BB> \<SS>'"
     and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
   shows "bnt_flip \<AA> \<BB> \<NN> : \<T> \<mapsto>\<^sub>C\<^sub>F \<T>' : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1-3) unfolding assms(4-6) by (intro bnt_flip_NTMap_is_ntcf)
 
 
 subsubsection\<open>Double-flip of a binatural transformation\<close>
 
 lemma bnt_flip_flip[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>) = \<NN>"
 proof(rule ntcf_eqI)
   interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
   interpret \<BB>: category \<alpha> \<BB> by (rule assms(2))
   interpret \<NN>: is_ntcf \<alpha> \<open>\<AA> \<times>\<^sub>C \<BB>\<close> \<CC> \<SS> \<SS>' \<NN> by (rule assms(3))
   from assms show
     "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>) : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   then have dom_lhs:
     "\<D>\<^sub>\<circ> (bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   show "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(3))
   then have dom_rhs: "\<D>\<^sub>\<circ> (\<NN>\<lparr>NTMap\<rparr>) = (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   show "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr> = \<NN>\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
     fix ab assume "ab \<in>\<^sub>\<circ> (\<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" 
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
       by (rule cat_prod_2_ObjE[OF assms(1,2)])
     from assms a b show 
       "bnt_flip \<BB> \<AA> (bnt_flip \<AA> \<BB> \<NN>)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>" 
       by (cs_concl cs_simp: cat_cs_simps ab_def cs_intro: cat_cs_intros)
   qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
 qed simp_all
 
 
 subsubsection\<open>A projection of a flip of a binatural transformation\<close>
 
 lemma bnt_flip_proj_snd[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F"
 proof(rule ntcf_eqI)
   from assms show "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F :
     \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms show "\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
     bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>C\<^sub>F :
     \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms have dom_lhs: 
     "\<D>\<^sub>\<circ> ((bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   from assms have dom_rhs: "\<D>\<^sub>\<circ> ((\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps)
   show "(bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     with assms show 
       "(bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<NN>\<^bsub>\<AA>,\<BB>\<^esub>(-,b)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
   qed (auto simp: cat_cs_intros)
 qed simp_all
 
 lemma bnt_flip_proj_fst[cat_cs_simps]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(-,a)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = \<NN>\<^bsub>\<AA>,\<BB>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F"
 proof-
   from assms have f_\<NN>: 
     "bnt_flip \<AA> \<BB> \<NN> :
       bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' :
       \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   show ?thesis
     by 
       (
         rule 
           bnt_flip_proj_snd
             [
               OF assms(2,1) f_\<NN> assms(4), 
               unfolded bnt_flip_flip[OF assms(1,2,3)],
               symmetric
             ]
       )
 qed
 
 
 subsubsection\<open>A flip of a binatural isomorphism\<close>
 
 lemma bnt_flip_is_iso_ntcf:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "bnt_flip \<AA> \<BB> \<NN> :
     bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o bifunctor_flip \<AA> \<BB> \<SS>' : 
     \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(rule is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf)
   from assms show f_\<NN>: "bnt_flip \<AA> \<BB> \<NN> :
     bifunctor_flip \<AA> \<BB> \<SS> \<mapsto>\<^sub>C\<^sub>F bifunctor_flip \<AA> \<BB> \<SS>' :
     \<BB> \<times>\<^sub>C \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
   fix a assume "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   with assms f_\<NN> show 
     "bnt_flip \<AA> \<BB> \<NN>\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
       bifunctor_flip \<AA> \<BB> \<SS>\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
       bifunctor_flip \<AA> \<BB> \<SS>'\<^bsub>\<BB>,\<AA>\<^esub>(a,-)\<^sub>C\<^sub>F :
       \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
 qed (simp_all add: assms)
 
 lemma bnt_flip_is_iso_ntcf'[cat_cs_intros]:
   assumes "category \<alpha> \<AA>"
     and "category \<alpha> \<BB>"
     and "\<NN> : \<SS> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<SS>' : \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<FF> = bifunctor_flip \<AA> \<BB> \<SS>"
     and "\<GG> = bifunctor_flip \<AA> \<BB> \<SS>'"
     and "\<DD> = \<BB> \<times>\<^sub>C \<AA>"
   shows "bnt_flip \<AA> \<BB> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using bnt_flip_is_iso_ntcf[OF assms(1-3)] unfolding assms(4-6) by simp
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Simple.thy
@@ -1,336 +1,339 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Simple categories\<close>
 theory CZH_ECAT_Simple
   imports 
     CZH_Foundations.CZH_SMC_Simple
     CZH_ECAT_Functor
     CZH_ECAT_Small_Functor
 begin
 
 
 
 subsection\<open>Background\<close>
 
 
 text\<open>
 The section presents a variety of simple categories, 
 (such as the empty category \<open>0\<close> and the singleton category \<open>1\<close>)
 and functors between them (see \cite{mac_lane_categories_2010}
 for further information).
 \<close>
 
 
 
 subsection\<open>Empty category \<open>0\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cat_0 :: "V"
   where "cat_0 = [0, 0, 0, 0, 0, 0]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cat_0_components:
   shows "cat_0\<lparr>Obj\<rparr> = 0"
     and "cat_0\<lparr>Arr\<rparr> = 0"
     and "cat_0\<lparr>Dom\<rparr> = 0"
     and "cat_0\<lparr>Cod\<rparr> = 0"
     and "cat_0\<lparr>Comp\<rparr> = 0"
     and "cat_0\<lparr>CId\<rparr> = 0"
   unfolding cat_0_def dg_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma smc_cat_0: "cat_smc cat_0 = smc_0"
   unfolding cat_smc_def cat_0_def smc_0_def dg_field_simps
   by (simp add: nat_omega_simps)
 
 lemmas_with (in \<Z>) [folded smc_cat_0, unfolded slicing_simps]: 
   cat_0_is_arr_iff = smc_0_is_arr_iff
 
 
 subsubsection\<open>\<open>0\<close> is a category\<close>
 
 lemma (in \<Z>) category_cat_0: "category \<alpha> cat_0"
 proof(intro categoryI)
   show "vfsequence cat_0" "vcard cat_0 = 6\<^sub>\<nat>" 
     by (simp_all add: cat_0_def nat_omega_simps)
 qed 
   (
     auto simp: 
       cat_0_components \<Z>_axioms cat_0_is_arr_iff smc_cat_0 \<Z>.semicategory_smc_0
   )
 
 
 
 subsection\<open>Empty functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition cf_0 :: "V \<Rightarrow> V"
   where "cf_0 \<AA> = [0, 0, cat_0, \<AA>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_0_components:
   shows "cf_0 \<AA>\<lparr>ObjMap\<rparr> = 0"
     and "cf_0 \<AA>\<lparr>ArrMap\<rparr> = 0"
     and "cf_0 \<AA>\<lparr>HomDom\<rparr> = cat_0"
     and "cf_0 \<AA>\<lparr>HomCod\<rparr> = \<AA>"
   unfolding cf_0_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma cf_smcf_cf_0: "cf_smcf (cf_0 \<AA>) = smcf_0 (cat_smc \<AA>)"
   unfolding 
     dg_field_simps dghm_field_simps 
     cf_smcf_def cf_0_def smc_0_def cat_0_def smcf_0_def cat_smc_def 
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Empty functor is a faithful functor\<close>
 
 lemma (in \<Z>) cf_0_is_functor: 
   assumes "category \<alpha> \<AA>"
   shows "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<AA>"
 proof(rule is_ft_functorI)
   show "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   proof(rule is_functorI, unfold smc_cat_0 cf_smcf_cf_0)
     show "vfsequence (cf_0 \<AA>)" unfolding cf_0_def by simp
     show "vcard (cf_0 \<AA>) = 4\<^sub>\<nat>"
       unfolding cf_0_def by (simp add: nat_omega_simps)
     from \<Z>.smcf_0_is_semifunctor assms show 
       "smcf_0 (cat_smc \<AA>) : smc_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"   
       by auto
   qed (auto simp: assms category_cat_0 cat_0_components cf_0_components)
   show "cf_smcf (cf_0 \<AA>) : cat_smc cat_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
     by 
       (
         auto simp:
           assms 
           \<Z>_axioms
           \<Z>.smcf_0_is_semifunctor  
           category.cat_semicategory 
           cf_smcf_cf_0 
           smc_cat_0
       )
 qed
 
 
 
 subsection\<open>\<open>1\<close>: category with one object and one arrow\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cat_1 :: "V \<Rightarrow> V \<Rightarrow> V"
   where "cat_1 \<aa> \<ff> =
     [
       set {\<aa>},
       set {\<ff>},
       set {\<langle>\<ff>, \<aa>\<rangle>},
       set {\<langle>\<ff>, \<aa>\<rangle>},
       set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>},
       set {\<langle>\<aa>, \<ff>\<rangle>}
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cat_1_components:
   shows "cat_1 \<aa> \<ff>\<lparr>Obj\<rparr> = set {\<aa>}"
     and "cat_1 \<aa> \<ff>\<lparr>Arr\<rparr> = set {\<ff>}"
     and "cat_1 \<aa> \<ff>\<lparr>Dom\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
     and "cat_1 \<aa> \<ff>\<lparr>Cod\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
     and "cat_1 \<aa> \<ff>\<lparr>Comp\<rparr> = set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>}"
     and "cat_1 \<aa> \<ff>\<lparr>CId\<rparr> = set {\<langle>\<aa>, \<ff>\<rangle>}"
   unfolding cat_1_def dg_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma smc_cat_1: "cat_smc (cat_1 \<aa> \<ff>) = smc_1 \<aa> \<ff>"
   unfolding cat_smc_def cat_1_def smc_1_def dg_field_simps
   by (simp add: nat_omega_simps)
 
 lemmas_with (in \<Z>) [folded smc_cat_1, unfolded slicing_simps]: 
   cat_1_is_arrI = smc_1_is_arrI
   and cat_1_is_arrD = smc_1_is_arrD
   and cat_1_is_arrE = smc_1_is_arrE
   and cat_1_is_arr_iff = smc_1_is_arr_iff
   and cat_1_Comp_app[cat_cs_simps] = smc_1_Comp_app
 
 
 subsubsection\<open>Object\<close>
 
 lemma cat_1_ObjI[cat_cs_intros]:
   assumes "a = \<aa>"
   shows "a \<in>\<^sub>\<circ> cat_1 \<aa> \<ff> \<lparr>Obj\<rparr>"
   unfolding cat_1_components(1) assms by simp
 
 
 subsubsection\<open>Identity\<close>
 
 lemma cat_1_CId_app: "cat_1 \<aa> \<ff>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr> = \<ff>" 
   unfolding cat_1_components by simp
 
 
 subsubsection\<open>Arrow with a domain and a codomain\<close>
 
 lemma cat_1_is_arrI:
   assumes "f = \<ff>" and "a = \<aa>" and "b = \<aa>"
   shows "f : a \<mapsto>\<^bsub>cat_1 \<aa> \<ff>\<^esub> b"
   by (rule is_arrI, unfold assms cat_1_components) auto
 
 
 subsubsection\<open>\<open>1\<close> is a category\<close>
 
 lemma (in \<Z>) category_cat_1: 
   assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
   shows "category \<alpha> (cat_1 \<aa> \<ff>)"
 proof(intro categoryI, unfold smc_cat_1)
   show "vfsequence (cat_1 \<aa> \<ff>)"
     unfolding cat_1_def by (simp add: nat_omega_simps)
   show "vcard (cat_1 \<aa> \<ff>) = 6\<^sub>\<nat>"
     unfolding cat_1_def by (simp add: nat_omega_simps)
 qed (auto simp: assms semicategory_smc_1 cat_1_is_arr_iff cat_1_components)
 
 lemmas [cat_cs_intros] = \<Z>.category_cat_1
 
 lemma (in \<Z>) finite_category_cat_1: 
   assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
   shows "finite_category \<alpha> (cat_1 \<aa> \<ff>)"
   by (intro finite_categoryI')
     (auto simp: cat_1_components intro: category_cat_1[OF assms])
 
 lemmas [cat_small_cs_intros] = \<Z>.finite_category_cat_1
 
 
 subsubsection\<open>Opposite of the category \<open>1\<close>\<close>
 
 lemma (in \<Z>) cat_1_op[cat_op_simps]:
   assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
   shows "op_cat (cat_1 \<aa> \<ff>) = cat_1 \<aa> \<ff>"
 proof(rule cat_eqI, unfold cat_op_simps)
   from assms show "category \<alpha> (op_cat (cat_1 \<aa> \<ff>))"
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   from assms show "category \<alpha> (cat_1 \<aa> \<ff>)"
     by (cs_concl cs_intro: cat_cs_intros)
   show "op_cat (cat_1 \<aa> \<ff>)\<lparr>Comp\<rparr> = cat_1 \<aa> \<ff>\<lparr>Comp\<rparr>"
     unfolding cat_1_components op_cat_components fflip_vsingleton ..
 qed (simp_all add: cat_1_components)
 
+lemma (in \<Z>) cat_1_op_0[cat_op_simps]: "op_cat (cat_1 0 0) = cat_1 0 0"
+  by (cs_concl cs_simp: cat_op_simps cs_intro: V_cs_intros cat_cs_intros)
+
 
 subsubsection\<open>Further properties\<close>
 
 lemma cf_const_if_HomCod_is_cat_1:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
   shows "\<KK> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>"
 proof(rule cf_eqI)
   interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(1))
   show "cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
     by (cs_concl cs_intro: cat_cs_intros)
   have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
   have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     by (simp add: cat_cs_simps)
   have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>" by (simp add: cat_cs_simps)
   have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
     by (simp add: cat_cs_simps)
   show "\<KK>\<lparr>ObjMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
     fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
       by (auto intro: \<KK>.cf_ObjMap_app_in_HomCod_Obj)
     then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<aa>" by (auto simp: cat_1_components)
     with prems show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by (auto simp: cat_cs_simps)
   qed (auto intro: cat_cs_intros)
   show "\<KK>\<lparr>ArrMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
     fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
     then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Arr\<rparr>"
       by (auto intro: \<KK>.cf_ArrMap_app_in_HomCod_Arr)
     then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<ff>" by (auto simp: cat_1_components)
     with prems show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
       by (auto simp: cat_1_CId_app cat_cs_simps)
   qed (auto intro: cat_cs_intros)
 qed (simp_all add: assms)
 
 lemma cf_const_if_HomDom_is_cat_1:
   assumes "\<KK> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<KK> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<KK> by (rule assms(1))
 
   from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<KK>.HomDom.cat_in_Obj_in_Vset)
   from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<KK>.HomDom.cat_in_Arr_in_Vset)
 
   from \<aa> \<ff> interpret cf_1: 
     is_tm_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<open>cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<close>
     by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
   
   show ?thesis
   proof(rule cf_eqI)
     show "cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_intro: cat_cs_intros)
     have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = set {\<aa>}" 
       by (simp add: cat_cs_simps cat_1_components)
     have ObjMap_dom_rhs: 
       "\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>) = set {\<aa>}"
       by (simp add: cat_cs_simps cat_1_components)
     show "\<KK>\<lparr>ObjMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>"
     proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> set {\<aa>}"
       then have a_def: "a = \<aa>" by simp
       show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_1_components(1) cat_cs_simps a_def 
               cs_intro: V_cs_intros
           )
     qed auto
 
     have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = set {\<ff>}" 
       by (simp add: cat_cs_simps cat_1_components)
     have ArrMap_dom_rhs: 
       "\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>) = set {\<ff>}"
       by (simp add: cat_cs_simps cat_1_components)
     
     show "\<KK>\<lparr>ArrMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>"
     proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
       fix f assume "f \<in>\<^sub>\<circ> set {\<ff>}"
       then have f_def: "f = \<ff>" by simp
       show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
         unfolding f_def
         by (subst cat_1_CId_app[symmetric, of \<ff> \<aa>])
           (
             cs_concl
               cs_simp: cat_1_components(1,2) cat_cs_simps 
               cs_intro: V_cs_intros cat_cs_intros
           )
     qed auto
 
   qed (simp_all add: assms)
 
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
--- a/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
+++ b/thys/CZH_Elementary_Categories/czh_ecategories/CZH_ECAT_Yoneda.thy
@@ -1,5624 +1,5624 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Yoneda Lemma\<close>
 theory CZH_ECAT_Yoneda
   imports 
     CZH_ECAT_FUNCT
     CZH_ECAT_Hom
 begin
 
 
 
 subsection\<open>Yoneda map\<close>
 
 
 text\<open>
 The Yoneda map is the bijection that is used in the statement of the
 Yoneda Lemma, as presented, for example, in Chapter III-2 in 
 \cite{mac_lane_categories_2010} or in subsection 1.15 
 in \cite{bodo_categories_1970}.
 \<close>
 
 definition Yoneda_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "Yoneda_map \<alpha> \<KK> r =
     (
       \<lambda>\<psi>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (\<KK>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomDom\<rparr>(r,-) \<KK>.
         \<psi>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<KK>\<lparr>HomDom\<rparr>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>
     )"
 
 
 text\<open>Elementary properties.\<close>
 
 mk_VLambda Yoneda_map_def
   |vsv Yoneda_map_vsv[cat_cs_intros]|
 
 mk_VLambda (in is_functor) Yoneda_map_def[where \<alpha>=\<alpha> and \<KK>=\<FF>, unfolded cf_HomDom]
   |vdomain Yoneda_map_vdomain|
   |app Yoneda_map_app[unfolded these_ntcfs_iff]|
 
 lemmas [cat_cs_simps] = is_functor.Yoneda_map_vdomain
 
 lemmas Yoneda_map_app[cat_cs_simps] = 
   is_functor.Yoneda_map_app[unfolded these_ntcfs_iff]
 
 
 
 subsection\<open>Yoneda component\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The Yoneda components are the components of the natural transformations
 that appear in the statement of the Yoneda Lemma (e.g., see 
 Chapter III-2 in \cite{mac_lane_categories_2010} or subsection 1.15 
 in \cite{bodo_categories_1970}).
 \<close>
 
 definition Yoneda_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "Yoneda_component \<KK> r u d =
     [
       (\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomDom\<rparr>) r d. \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>),
       Hom (\<KK>\<lparr>HomDom\<rparr>) r d,
       \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma (in is_functor) Yoneda_component_components: 
   shows "Yoneda_component \<FF> r u d\<lparr>ArrVal\<rparr> =
     (\<lambda>f\<in>\<^sub>\<circ>Hom \<AA> r d. \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>)"
     and "Yoneda_component \<FF> r u d\<lparr>ArrDom\<rparr> = Hom \<AA> r d"
     and "Yoneda_component \<FF> r u d\<lparr>ArrCod\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
   unfolding Yoneda_component_def arr_field_simps 
   by (simp_all add: nat_omega_simps cat_cs_simps)
 
 
 subsubsection\<open>Arrow value\<close>
 
 mk_VLambda (in is_functor) Yoneda_component_components(1)
   |vsv Yoneda_component_ArrVal_vsv|
   |vdomain Yoneda_component_ArrVal_vdomain|
   |app Yoneda_component_ArrVal_app[unfolded in_Hom_iff]|
 
 lemmas [cat_cs_simps] = is_functor.Yoneda_component_ArrVal_vdomain
 
 lemmas Yoneda_component_ArrVal_app[cat_cs_simps] = 
   is_functor.Yoneda_component_ArrVal_app[unfolded in_Hom_iff]
 
 
 subsubsection\<open>Yoneda component is an arrow in the category \<open>Set\<close>\<close>
 
 lemma (in category) cat_Yoneda_component_is_arr:
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "Yoneda_component \<KK> r u d : Hom \<CC> r d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"   
 proof-
   interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1)) 
   show ?thesis
   proof(intro cat_Set_is_arrI arr_SetI, unfold \<KK>.Yoneda_component_components)
     show "vfsequence (Yoneda_component \<KK> r u d)" 
       unfolding Yoneda_component_def by simp
     show "vcard (Yoneda_component \<KK> r u d) = 3\<^sub>\<nat>"
       unfolding Yoneda_component_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>Hom \<CC> r d. \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr>) \<subseteq>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
     proof(rule vrange_VLambda_vsubset)
       fix f assume "f \<in>\<^sub>\<circ> Hom \<CC> r d"
       then have \<KK>f: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>" 
         by (auto simp: cat_cs_intros)
       note \<KK>f_simps = cat_Set_is_arrD[OF \<KK>f]
       interpret \<KK>f: arr_Set \<alpha> \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close> by (rule \<KK>f_simps(1))          
       have "u \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>)" 
         by (simp add: \<KK>f_simps assms cat_Set_cs_simps)
       with \<KK>f.arr_Set_ArrVal_vrange[unfolded \<KK>f_simps] show 
         "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>u\<rparr> \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
         by (blast elim: \<KK>f.ArrVal.vsv_value)
     qed 
     from assms \<KK>.HomCod.cat_Obj_vsubset_Vset show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
       by (auto dest: \<KK>.cf_ObjMap_app_in_HomCod_Obj)
   qed (auto simp: assms cat_cs_intros)
 qed
 
 lemma (in category) cat_Yoneda_component_is_arr':
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" 
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "s = Hom \<CC> r d"
     and "t = \<KK>\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
     and "\<DD> = cat_Set \<alpha>"
   shows "Yoneda_component \<KK> r u d : s \<mapsto>\<^bsub>\<DD>\<^esub> t"   
   unfolding assms(5-7) using assms(1-4) by (rule cat_Yoneda_component_is_arr)
 
 lemmas [cat_cs_intros] = category.cat_Yoneda_component_is_arr'[rotated 1]
 
 
 
 subsection\<open>Yoneda arrow\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The Yoneda arrows are the natural transformations that 
 appear in the statement of the Yoneda Lemma in Chapter III-2 in 
 \cite{mac_lane_categories_2010} and subsection 1.15 
 in \cite{bodo_categories_1970}.
 \<close>
 
 definition Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" 
   where "Yoneda_arrow \<alpha> \<KK> r u =
     [
       (\<lambda>d\<in>\<^sub>\<circ>\<KK>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. Yoneda_component \<KK> r u d),
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomDom\<rparr>(r,-),
       \<KK>,
       \<KK>\<lparr>HomDom\<rparr>,
       cat_Set \<alpha>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma (in is_functor) Yoneda_arrow_components:
   shows "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTMap\<rparr> = 
     (\<lambda>d\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. Yoneda_component \<FF> r u d)"
     and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(r,-)"
     and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTCod\<rparr> = \<FF>"
     and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDGDom\<rparr> = \<AA>"
     and "Yoneda_arrow \<alpha> \<FF> r u\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
   unfolding Yoneda_arrow_def nt_field_simps 
   by (simp_all add: nat_omega_simps cat_cs_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda (in is_functor) Yoneda_arrow_components(1)
   |vsv Yoneda_arrow_NTMap_vsv|
   |vdomain Yoneda_arrow_NTMap_vdomain|
   |app Yoneda_arrow_NTMap_app|
 
 lemmas [cat_cs_simps] = is_functor.Yoneda_arrow_NTMap_vdomain
 
 lemmas Yoneda_arrow_NTMap_app[cat_cs_simps] = 
   is_functor.Yoneda_arrow_NTMap_app
 
 
 subsubsection\<open>Yoneda arrow is a natural transformation\<close>
 
 lemma (in category) cat_Yoneda_arrow_is_ntcf:
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" 
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   shows "Yoneda_arrow \<alpha> \<KK> r u : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1)) 
   note \<KK>ru = cat_Yoneda_component_is_arr[OF assms]
   let ?\<KK>ru = \<open>Yoneda_component \<KK> r u\<close>
 
   show ?thesis
   proof(intro is_ntcfI', unfold \<KK>.Yoneda_arrow_components)
 
     show "vfsequence (Yoneda_arrow \<alpha> \<KK> r u)"
       unfolding Yoneda_arrow_def by simp
     show "vcard (Yoneda_arrow \<alpha> \<KK> r u) = 5\<^sub>\<nat>" 
       unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)
 
     show
       "(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>a\<rparr> :
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
       using that assms category_axioms
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_op_simps V_cs_simps 
             cs_intro: cat_cs_intros
         )
     show 
       "(\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. ?\<KK>ru d)\<lparr>a\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
     proof-
 
       note \<MM>a = \<KK>ru[OF cat_is_arrD(2)[OF that]]
       note \<MM>b = \<KK>ru[OF cat_is_arrD(3)[OF that]]
 
       from category_axioms assms that \<MM>b have b_f:
         "?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ> :
           Hom \<CC> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by
           (
             cs_concl cs_intro:
               cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       then have dom_lhs: 
         "\<D>\<^sub>\<circ> ((?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>) =
           Hom \<CC> r a"
           by (cs_concl cs_simp: cat_cs_simps)
       from assms that \<MM>a have f_a: 
         "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a :
           Hom \<CC> r a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by (cs_concl cs_intro: cat_cs_intros)
       then have dom_rhs: 
         "\<D>\<^sub>\<circ> ((\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>) = Hom \<CC> r a"
         by (cs_concl cs_simp: cat_cs_simps)
 
       have [cat_cs_simps]:
         "?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ> =
           \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a"
       proof(rule arr_Set_eqI[of \<alpha>])
 
         from b_f show arr_Set_b_f:
           "arr_Set \<alpha> (?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)"
           by (auto simp: cat_Set_is_arrD(1))
         interpret b_f: arr_Set \<alpha> \<open>?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>\<close>
           by (rule arr_Set_b_f)
         from f_a show arr_Set_f_a:
           "arr_Set \<alpha> (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)"
           by (auto simp: cat_Set_is_arrD(1))
         interpret f_a: arr_Set \<alpha> \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a\<close>
           by (rule arr_Set_f_a)
 
         show 
           "(?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr> =
             (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
           fix q assume "q : r \<mapsto>\<^bsub>\<CC>\<^esub> a"
           from category_axioms assms that this \<MM>a \<MM>b show 
             "(?\<KK>ru b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>, f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> =
               (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<KK>ru a)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr>"
             by 
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_op_simps
                   cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
               )
         qed (use arr_Set_b_f arr_Set_f_a in auto)
 
       qed (use b_f f_a in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
   
       from that category_axioms assms \<MM>a \<MM>b show ?thesis
         by
           (
             cs_concl
               cs_simp: V_cs_simps cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros
           )
     
     qed
 
   qed (auto simp: assms(2) cat_cs_intros)
 
 qed
 
 
 
 subsection\<open>Yoneda Lemma\<close>
 
 text\<open>
 The following lemma is approximately equivalent to the Yoneda Lemma 
 stated in subsection 1.15 in \cite{bodo_categories_1970} 
 (the first two conclusions correspond to the statement of the 
 Yoneda lemma in Chapter III-2 in \cite{mac_lane_categories_2010}).
 \<close>
 
 lemma (in category) cat_Yoneda_Lemma: 
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "v11 (Yoneda_map \<alpha> \<KK> r)" 
     and "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     and "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)"
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1)) 
 
   from assms(2) \<KK>.HomCod.cat_Obj_vsubset_Vset \<KK>.cf_ObjMap_app_in_HomCod_Obj 
   have \<KK>r_in_Vset: "\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
     by auto
 
   show Ym: "v11 (Yoneda_map \<alpha> \<KK> r)"
   proof(intro vsv.vsv_valeq_v11I, unfold \<KK>.Yoneda_map_vdomain these_ntcfs_iff)
 
     fix \<MM> \<NN>
     assume prems: 
       "\<MM> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       "Yoneda_map \<alpha> \<KK> r\<lparr>\<MM>\<rparr> = Yoneda_map \<alpha> \<KK> r\<lparr>\<NN>\<rparr>"
     from prems(3) have \<MM>r_\<NN>r:
       "\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
       unfolding 
         Yoneda_map_app[OF assms(1) prems(1)] 
         Yoneda_map_app[OF assms(1) prems(2)]
       by simp
 
     interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<MM>  
       by (rule prems(1))
     interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<NN> 
       by (rule prems(2))
 
     show "\<MM> = \<NN>"
     proof
       (
         rule ntcf_eqI[OF prems(1,2)]; 
         (rule refl)?;
         rule vsv_eqI, 
         unfold \<MM>.ntcf_NTMap_vdomain \<NN>.ntcf_NTMap_vdomain
       )
 
       fix d assume prems': "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 
       note \<MM>d_simps = cat_Set_is_arrD[OF \<MM>.ntcf_NTMap_is_arr[OF prems']]
       interpret \<MM>d: arr_Set \<alpha> \<open>\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<close> by (rule \<MM>d_simps(1))
 
       note \<NN>d_simps = cat_Set_is_arrD[OF \<NN>.ntcf_NTMap_is_arr[OF prems']]
       interpret \<NN>d: arr_Set \<alpha> \<open>\<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<close> by (rule \<NN>d_simps(1))
 
       show "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
       proof(rule arr_Set_eqI[of \<alpha>])
         show "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>"
         proof
           (
             rule vsv_eqI, 
             unfold 
               \<NN>d.arr_Set_ArrVal_vdomain 
               \<MM>d.arr_Set_ArrVal_vdomain  
               \<MM>d_simps
               \<NN>d_simps
           )
           fix f assume prems'': "f \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ObjMap\<rparr>\<lparr>d\<rparr>"
           from prems'' prems' category_axioms assms(2) have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> d"
             by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_op_intros)
           from \<MM>.ntcf_Comp_commute[OF f] have 
             "(
               \<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
             )\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> =
               (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
             by simp
           from this category_axioms assms(2) f prems prems' have \<MM>df:
             "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
               \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>\<rparr>"
             by 
               (
                 cs_prems
                   cs_simp: cat_cs_simps cat_op_simps 
                   cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
               )
           from \<NN>.ntcf_Comp_commute[OF f] have
             "(
               \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> 
               Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
             )\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> = 
               (\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>"
             by simp
           from this category_axioms assms(2) f prems prems' have \<NN>df:
             "\<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
               \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr>\<rparr>"
             by
               (
                 cs_prems
                   cs_simp: cat_cs_simps cat_op_simps 
                   cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
               )
           show "\<MM>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
             unfolding \<MM>df \<NN>df \<MM>r_\<NN>r by simp
         qed auto
 
       qed (simp_all add: \<MM>d_simps \<NN>d_simps)
 
     qed auto
 
   qed (auto simp: Yoneda_map_vsv)
 
   interpret Ym: v11 \<open>Yoneda_map \<alpha> \<KK> r\<close> by (rule Ym)
 
   have YY: "Yoneda_map \<alpha> \<KK> r\<lparr>Yoneda_arrow \<alpha> \<KK> r a\<rparr> = a" 
     if "a \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>" for a
   proof-
     note cat_Yoneda_arrow_is_ntcf[OF assms that]
     moreover with assms have Ya: "Yoneda_arrow \<alpha> \<KK> r a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)" 
       by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
     ultimately show "Yoneda_map \<alpha> \<KK> r\<lparr>Yoneda_arrow \<alpha> \<KK> r a\<rparr> = a"
       using assms that \<KK>r_in_Vset
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed        
 
   show [simp]: "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   proof(intro vsubset_antisym)
 
     show "\<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r) \<subseteq>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
       unfolding Yoneda_map_def
     proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff \<KK>.cf_HomDom)
       fix \<MM> assume prems: "\<MM> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F \<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       then interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<KK> \<MM> .
       note \<MM>r_simps = cat_Set_is_arrD[OF \<MM>.ntcf_NTMap_is_arr[OF assms(2)]]
       interpret \<MM>r: arr_Set \<alpha> \<open>\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<close> by (rule \<MM>r_simps(1))
       from prems category_axioms assms(2) have 
         "\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>)"
         unfolding \<MM>r.arr_Set_ArrVal_vdomain \<MM>r_simps
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
       then have "\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>)"
         by (blast elim: \<MM>r.ArrVal.vsv_value)
       then show "\<MM>\<lparr>NTMap\<rparr>\<lparr>r\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>\<rparr> \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
         by (auto simp: \<MM>r_simps dest!: vsubsetD[OF \<MM>r.arr_Set_ArrVal_vrange])
     qed
     
     show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)"
     proof(intro vsubsetI)
       fix u assume prems: "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
       from cat_Yoneda_arrow_is_ntcf[OF assms prems] have 
         "Yoneda_arrow \<alpha> \<KK> r u \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)" 
         by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
       with YY[OF prems] show "u \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)" 
         by (force dest!: vdomain_atD)
     qed
 
   qed
 
   show "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)"
   proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
     from Ym show "vsv ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>)" by auto
     show "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>\<lparr>a\<rparr> = (\<lambda>u\<in>\<^sub>\<circ>\<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>. Yoneda_arrow \<alpha> \<KK> r u)\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)" for a
     proof-
       from that have a: "a \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>" by simp
       note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
       then have "Yoneda_arrow \<alpha> \<KK> r a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (Yoneda_map \<alpha> \<KK> r)"
         by 
           (
             cs_concl 
               cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
           )
       with Ya YY[OF a] a show ?thesis
         by 
           (
             intro Ym.v11_vconverse_app[
               unfolded \<KK>.Yoneda_map_vdomain these_ntcfs_iff
               ]
           )
           (simp_all add: these_ntcfs_iff cat_cs_simps)
     qed
   qed auto
 
 qed
 
 
 
 subsection\<open>Inverse of the Yoneda map\<close>
 
 lemma (in category) inv_Yoneda_map_v11: 
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "v11 ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>)"
   using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
 
 lemma (in category) inv_Yoneda_map_vdomain: 
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>) = \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   unfolding cat_Yoneda_Lemma(3)[OF assms] by simp
 
 lemmas [cat_cs_simps] = category.inv_Yoneda_map_vdomain
 
 lemma (in category) inv_Yoneda_map_app: 
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "u \<in>\<^sub>\<circ> \<KK>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   shows "(Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>\<lparr>u\<rparr> = Yoneda_arrow \<alpha> \<KK> r u"
   using assms(3) unfolding cat_Yoneda_Lemma(3)[OF assms(1,2)] by simp
 
 lemmas [cat_cs_simps] = category.inv_Yoneda_map_app
 
 lemma (in category) inv_Yoneda_map_vrange: 
   assumes "\<KK> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "\<R>\<^sub>\<circ> ((Yoneda_map \<alpha> \<KK> r)\<inverse>\<^sub>\<circ>) =
     these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<KK>"
 proof-
   interpret \<KK>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> by (rule assms(1)) 
   show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
 qed
 
 
 
 subsection\<open>
 Component of a composition of a \<open>Hom\<close>-natural transformation 
 with natural transformations
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The following definition is merely a technical generalization
 that is used in the context of the description of the 
 composition of a \<open>Hom\<close>-natural transformation with a natural transformation
 later in this section
 (also see subsection 1.15 in \cite{bodo_categories_1970}).
 \<close>
 
 definition ntcf_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_Hom_component \<phi> \<psi> a b =
     [
       (
         \<lambda>f\<in>\<^sub>\<circ>Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>).
           \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> f \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>
       ),
       Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>),
       Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_Hom_component_components: 
   shows "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr> =
     (
       \<lambda>f\<in>\<^sub>\<circ>Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>).
         \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> f \<circ>\<^sub>A\<^bsub>\<psi>\<lparr>NTDGCod\<rparr>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>
     )"
     and "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> =
       Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> =
       Hom (\<phi>\<lparr>NTDGCod\<rparr>) (\<phi>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<psi>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   unfolding ntcf_Hom_component_def arr_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Arrow value\<close>
 
 mk_VLambda ntcf_Hom_component_components(1)
   |vsv ntcf_Hom_component_ArrVal_vsv[intro]|
 
 context
   fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
   assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
 interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)
 
 mk_VLambda 
   ntcf_Hom_component_components(1)
     [
       of \<phi> \<psi>, 
       unfolded 
         \<phi>.ntcf_NTDom \<psi>.ntcf_NTDom 
         \<phi>.ntcf_NTCod \<psi>.ntcf_NTCod 
         \<phi>.ntcf_NTDGDom \<psi>.ntcf_NTDGDom
         \<phi>.ntcf_NTDGCod \<psi>.ntcf_NTDGCod
     ]
   |vdomain ntcf_Hom_component_ArrVal_vdomain|
   |app ntcf_Hom_component_ArrVal_app[unfolded in_Hom_iff]|
 
 lemmas [cat_cs_simps] = 
   ntcf_Hom_component_ArrVal_vdomain
   ntcf_Hom_component_ArrVal_app
 
 lemma ntcf_Hom_component_ArrVal_vrange:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows 
     "\<R>\<^sub>\<circ> (ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof
   (
     rule vsv.vsv_vrange_vsubset, 
     unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
   )
   fix f assume "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   with assms \<phi> \<psi> show 
     "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed (rule ntcf_Hom_component_ArrVal_vsv)
 
 end
 
 
 subsubsection\<open>Arrow domain and codomain\<close>
 
 context
   fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
   assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
 interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)
 
 lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
   "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
 
 lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
   "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
 
 end
 
 
 subsubsection\<open>
 Component of a composition of a \<open>Hom\<close>-natural transformation 
 with natural transformations is an arrow in the category \<open>Set\<close>
 \<close>
 
 lemma (in category) cat_ntcf_Hom_component_is_arr:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows 
     "ntcf_Hom_component \<phi> \<psi> a b :
       Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))
 
   from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
 
   show ?thesis
   proof(intro cat_Set_is_arrI arr_SetI)
     show "vfsequence (ntcf_Hom_component \<phi> \<psi> a b)"
       unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
     show "vcard (ntcf_Hom_component \<phi> \<psi> a b) = 3\<^sub>\<nat>"
       unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
     from assms ntcf_Hom_component_ArrVal_vrange[OF assms(1,2) a assms(4)] show 
       "\<R>\<^sub>\<circ> (ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> 
         ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     from assms(1,2,4) a show "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(1,2,4) a show "ntcf_Hom_component \<phi> \<psi> a b\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (use assms in \<open>auto simp: ntcf_Hom_component_components cat_cs_simps\<close>)
 
 qed
 
 lemma (in category) cat_ntcf_Hom_component_is_arr':
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<AA>' = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "\<BB>' = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "\<CC>' = cat_Set \<alpha>"
   shows "ntcf_Hom_component \<phi> \<psi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
   using assms(1-4) unfolding assms(5-7) by (rule cat_ntcf_Hom_component_is_arr)
   
 lemmas [cat_cs_intros] = category.cat_ntcf_Hom_component_is_arr'
 
 
 subsubsection\<open>
 Naturality of the components of a composition of 
 a \<open>Hom\<close>-natural transformation with natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_Hom_component_nat:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "g : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> a'"
     and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'" 
   shows
     "ntcf_Hom_component \<phi> \<psi> a' b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
      cf_hom \<CC> [\<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> =
       cf_hom \<CC> [\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>, \<GG>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
       ntcf_Hom_component \<phi> \<psi> a b"
 proof-
 
   let ?Y_ab = \<open>ntcf_Hom_component \<phi> \<psi> a b\<close>
     and ?Y_a'b' = \<open>ntcf_Hom_component \<phi> \<psi> a' b'\<close>
     and ?\<GG>g = \<open>\<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
     and ?\<FF>'f = \<open>\<FF>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
     and ?\<FF>g = \<open>\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>\<close>
     and ?\<GG>'f = \<open>\<GG>'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
     and ?\<GG>a = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
     and ?\<FF>'b = \<open>\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
     and ?\<FF>a' = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>\<close>
     and ?\<GG>'b' = \<open>\<GG>'\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
 
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   from assms(3) have g: "g : a' \<mapsto>\<^bsub>\<AA>\<^esub> a" unfolding cat_op_simps by simp
 
   from Set.category_axioms category_axioms assms g have a'b_Gg\<FF>'f:
     "?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ> :
       Hom \<CC> ?\<GG>a ?\<FF>'b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a' ?\<GG>'b'"
     by 
       (
         cs_concl
           cs_simp: cat_cs_simps cat_op_simps 
           cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
       )
   then have dom_lhs: 
     "\<D>\<^sub>\<circ> ((?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>) = 
       Hom \<CC> ?\<GG>a ?\<FF>'b"
     by (cs_concl cs_simp: cat_cs_simps)
   from Set.category_axioms category_axioms assms g have \<FF>g\<GG>'f_ab: 
     "cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab : 
       Hom \<CC> ?\<GG>a ?\<FF>'b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a' ?\<GG>'b'"
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_op_simps 
           cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
       )
   then have dom_rhs: 
     "\<D>\<^sub>\<circ> ((cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>) =
       Hom \<CC> ?\<GG>a ?\<FF>'b"
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
     from a'b_Gg\<FF>'f show arr_Set_a'b_Gg\<FF>'f:
       "arr_Set \<alpha> (?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)"
       by (auto dest: cat_Set_is_arrD(1))
     from \<FF>g\<GG>'f_ab show arr_Set_\<FF>g\<GG>'f_ab: 
       "arr_Set \<alpha> (cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)"
       by (auto dest: cat_Set_is_arrD(1))
     show 
       "(?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr> =
         (cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
       fix h assume prems: "h : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       from assms(1,2) g have [cat_cs_simps]:
         "\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<GG>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>))) =
           \<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g)))"
         by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
       also from assms(1,2,4) prems g have "\<dots> =
         (((\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>'f) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g"
         by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (*slow*)
       also from assms(1,2,4) have "\<dots> =
         (((?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>) \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g"
         by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
       also from assms(1,2,4) prems g have "\<dots> =
         ?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g)))"
         by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (*slow*)
       finally have nat:
         "\<psi>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<FF>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (?\<GG>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>))) =
           ?\<GG>'f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<FF>g)))".
       from prems Set.category_axioms category_axioms assms(1,2,4) g show 
         "(?Y_a'b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> cf_hom \<CC> [?\<GG>g, ?\<FF>'f]\<^sub>\<circ>)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> =
           (cf_hom \<CC> [?\<FF>g, ?\<GG>'f]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Y_ab)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
         by (*slow*)
           (
             cs_concl
               cs_simp: nat cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed (use arr_Set_a'b_Gg\<FF>'f arr_Set_\<FF>g\<GG>'f_ab in auto)
 
   qed (use a'b_Gg\<FF>'f \<FF>g\<GG>'f_ab in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 
 subsubsection\<open>
 Composition of the components of a composition of a \<open>Hom\<close>-natural 
 transformation with natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_Hom_component_Comp:
   assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<psi>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows 
     "ntcf_Hom_component \<phi> \<psi>' a b \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ntcf_Hom_component \<phi>' \<psi> a b =
       ntcf_Hom_component (\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>) (\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>) a b"
     (is \<open>?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi> = ?\<phi>'\<phi>\<psi>'\<psi>\<close>)
 proof-
 
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   from assms Set.category_axioms category_axioms have \<phi>\<psi>'_\<phi>'\<psi>: 
     "?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi> :
       Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<HH>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"    
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   then have dom_lhs: 
     "\<D>\<^sub>\<circ> ((?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr>) = 
       Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by (cs_concl cs_simp: cat_cs_simps)
   from assms Set.category_axioms category_axioms have \<phi>'\<phi>\<psi>'\<psi>: 
     "?\<phi>'\<phi>\<psi>'\<psi> :
       Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<HH>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"    
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   then have dom_rhs: 
     "\<D>\<^sub>\<circ> (?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" 
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
     from \<phi>\<psi>'_\<phi>'\<psi> show arr_Set_\<phi>\<psi>'_\<phi>'\<psi>: "arr_Set \<alpha> (?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)"
       by (auto dest: cat_Set_is_arrD(1))
     from \<phi>'\<phi>\<psi>'\<psi> show arr_Set_\<phi>'\<phi>\<psi>'\<psi>: "arr_Set \<alpha> ?\<phi>'\<phi>\<psi>'\<psi>"
       by (auto dest: cat_Set_is_arrD(1))
     show "(?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr> = ?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
       fix f assume "f : \<HH>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       with category_axioms assms Set.category_axioms show 
         "(?\<phi>\<psi>' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<phi>'\<psi>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = ?\<phi>'\<phi>\<psi>'\<psi>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
         by 
           (
             cs_concl
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed (use arr_Set_\<phi>'\<phi>\<psi>'\<psi> arr_Set_\<phi>\<psi>'_\<phi>'\<psi> in auto)
     
   qed (use \<phi>\<psi>'_\<phi>'\<psi> \<phi>'\<phi>\<psi>'\<psi> in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp
 
 
 subsubsection\<open>
 Component of a composition of \<open>Hom\<close>-natural 
 transformation with the identity natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_Hom_component_ntcf_id:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF>': \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows 
     "ntcf_Hom_component (ntcf_id \<FF>) (ntcf_id \<FF>') a b =
       cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<rparr>"
     (is \<open>?\<FF>\<FF>' = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<close>)
 proof-
 
   interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
   interpret \<FF>': is_functor \<alpha> \<BB> \<CC> \<FF>' by (rule assms(2))
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   from assms Set.category_axioms category_axioms have \<FF>\<FF>': 
     "?\<FF>\<FF>' :
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"    
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   then have dom_lhs: "\<D>\<^sub>\<circ> (?\<FF>\<FF>'\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by (cs_concl cs_simp: cat_cs_simps)
 
   from category_axioms assms Set.category_axioms have \<FF>a\<FF>'b: 
     "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr> :
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by 
       (
         cs_concl cs_full 
           cs_simp: cat_Set_cs_simps cat_Set_components(1) 
           cs_intro: cat_cs_intros
       )
   then have dom_rhs: 
     "\<D>\<^sub>\<circ> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
     from \<FF>\<FF>' show arr_Set_\<FF>\<psi>: "arr_Set \<alpha> ?\<FF>\<FF>'" 
       by (auto dest: cat_Set_is_arrD(1))
     from \<FF>a\<FF>'b show arr_Set_\<FF>a\<FF>'b: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>)" 
       by (auto dest: cat_Set_is_arrD(1))
     show "?\<FF>\<FF>'\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)  
       fix f assume "f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       with category_axioms Set.category_axioms assms show 
         "?\<FF>\<FF>'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>?\<FF>a\<FF>'b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
     qed (use arr_Set_\<FF>a\<FF>'b in auto)
       
   qed (use \<FF>\<FF>' \<FF>a\<FF>'b in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id
 
 
 
 subsection\<open>
 Component of a composition of a \<open>Hom\<close>-natural transformation 
 with a natural transformation
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition ntcf_lcomp_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_lcomp_Hom_component \<phi> a b =
     ntcf_Hom_component \<phi> (ntcf_id (cf_id (\<phi>\<lparr>NTDGCod\<rparr>))) a b"
 
 definition ntcf_rcomp_Hom_component :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_rcomp_Hom_component \<psi> a b =
     ntcf_Hom_component (ntcf_id (cf_id (\<psi>\<lparr>NTDGCod\<rparr>))) \<psi> a b"
 
 
 subsubsection\<open>Arrow value\<close>
 
 lemma ntcf_lcomp_Hom_component_ArrVal_vsv: 
   "vsv (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>)"
   unfolding ntcf_lcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
 
 lemma ntcf_rcomp_Hom_component_ArrVal_vsv: 
   "vsv (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>)"
   unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
 
 lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   show ?thesis
     using assms
     unfolding ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_rcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   show ?thesis
     using assms
     unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_lcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "h : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = h \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<phi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   show ?thesis
     using assms
     unfolding cat_op_simps ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_rcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "h : a \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   show ?thesis
     using assms
     unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_lcomp_Hom_component_ArrVal_vrange: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms(2) have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   from assms(1,3) a have 
     "\<R>\<^sub>\<circ> (ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by 
       (
         unfold cat_op_simps ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod, 
         intro ntcf_Hom_component_ArrVal_vrange
       ) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
   from this assms(3) show ?thesis by (cs_prems cs_simp: cat_cs_simps)
 qed
 
 lemma ntcf_rcomp_Hom_component_ArrVal_vrange: 
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms(2) have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   from assms(1,3) a have 
     "\<R>\<^sub>\<circ> (ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
       Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by 
       (
         unfold ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod, 
         intro ntcf_Hom_component_ArrVal_vrange
       ) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from this a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
 qed
 
 
 subsubsection\<open>Arrow domain and codomain\<close>
 
 lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_rcomp_Hom_component_ArrDom[cat_cs_simps]:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrDom\<rparr> = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms show ?thesis
     unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_lcomp_Hom_component_ArrCod[cat_cs_simps]:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_lcomp_Hom_component \<phi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_rcomp_Hom_component_ArrCod[cat_cs_simps]:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_rcomp_Hom_component \<psi> a b\<lparr>ArrCod\<rparr> = Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" 
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms show ?thesis
     unfolding cat_op_simps ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>
 Component of a composition of a \<open>Hom\<close>-natural transformation 
 with a natural transformation is an arrow in the category \<open>Set\<close>
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_lcomp_Hom_component \<phi> a b :
     Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   from assms(1,3) a have 
     "ntcf_lcomp_Hom_component \<phi> a b :
       Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> 
       Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     unfolding ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (intro cat_ntcf_Hom_component_is_arr)
       (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
 qed
 
 lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr':
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<AA>' = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
     and "\<BB>' = Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
     and "\<CC>' = cat_Set \<alpha>"
   shows "ntcf_lcomp_Hom_component \<phi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
   using assms(1-3) 
   unfolding assms(4-6) 
   by (rule cat_ntcf_lcomp_Hom_component_is_arr)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_component_is_arr'
 
 lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "ntcf_rcomp_Hom_component \<psi> a b :
     Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   from assms(1,3) a have 
     "ntcf_rcomp_Hom_component \<psi> a b :
       Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom \<CC> (cf_id \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     unfolding ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (intro cat_ntcf_Hom_component_is_arr)
       (cs_concl cs_intro: cat_cs_intros cat_op_intros)
   from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
 qed
 
 lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr':
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<AA>' = Hom \<CC> a (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "\<BB>' = Hom \<CC> a (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "\<CC>' = cat_Set \<alpha>"
   shows "ntcf_rcomp_Hom_component \<psi> a b : \<AA>' \<mapsto>\<^bsub>\<CC>'\<^esub> \<BB>'"
   using assms(1-3) 
   unfolding assms(4-6)
   by (rule cat_ntcf_rcomp_Hom_component_is_arr)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_component_is_arr'
 
 
 
 subsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with two natural transformations
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See subsection 1.15 in \cite{bodo_categories_1970}.\<close>
 
 definition ntcf_Hom :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/_-,_-/')\<close>)
   where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) =
     [
       (
         \<lambda>ab\<in>\<^sub>\<circ>(op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
           ntcf_Hom_component \<phi> \<psi> (vpfst ab) (vpsnd ab)
       ),
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTCod\<rparr>-,\<psi>\<lparr>NTDom\<rparr>-),
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTDom\<rparr>-,\<psi>\<lparr>NTCod\<rparr>-),
       op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>,
       cat_Set \<alpha>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_Hom_components:
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr> =
     (
       \<lambda>ab\<in>\<^sub>\<circ>(op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>)\<lparr>Obj\<rparr>.
         ntcf_Hom_component \<phi> \<psi> (vpfst ab) (vpsnd ab)
     )"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDom\<rparr> =
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTCod\<rparr>-,\<psi>\<lparr>NTDom\<rparr>-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTCod\<rparr> =
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<psi>\<lparr>NTDGCod\<rparr>(\<phi>\<lparr>NTDom\<rparr>-,\<psi>\<lparr>NTCod\<rparr>-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDGDom\<rparr> = op_cat (\<phi>\<lparr>NTDGDom\<rparr>) \<times>\<^sub>C \<psi>\<lparr>NTDGDom\<rparr>"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
   unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda ntcf_Hom_components(1)
   |vsv ntcf_Hom_NTMap_vsv|
 
 context
   fixes \<alpha> \<phi> \<psi> \<FF> \<GG> \<FF>' \<GG>' \<AA> \<BB> \<CC>
   assumes \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<psi>: "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule \<phi>)
 interpretation \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule \<psi>)
 
 mk_VLambda ntcf_Hom_components(1)[of _ \<phi> \<psi>, simplified]
   |vdomain ntcf_Hom_NTMap_vdomain[unfolded in_Hom_iff]|
 
 lemmas [cat_cs_simps] = ntcf_Hom_NTMap_vdomain
 
 lemma ntcf_Hom_NTMap_app[cat_cs_simps]:
   assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_Hom_component \<phi> \<psi> a b"
   using assms
   unfolding ntcf_Hom_components
   by (simp add: nat_omega_simps cat_cs_simps)
 
 end
 
 lemma (in category) ntcf_Hom_NTMap_vrange: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))
   show ?thesis
   proof
     (
       rule vsv.vsv_vrange_vsubset, 
       unfold ntcf_Hom_NTMap_vdomain[OF assms] cat_cs_simps
     )
     fix ab assume "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" 
         and a: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by 
         (
           rule cat_prod_2_ObjE[
             OF \<phi>.NTDom.HomDom.category_op \<psi>.NTDom.HomDom.category_axioms
             ]
         )
     from assms a b category_cat_Set category_axioms show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
       unfolding ab_def cat_op_simps
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed (simp add: ntcf_Hom_NTMap_vsv)
 qed
 
 
 subsubsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with 
 two natural transformations is a natural transformation
 \<close>
 
 lemma (in category) cat_ntcf_Hom_is_ntcf: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-) :
     op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
 
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(2))
 
   show ?thesis
   proof(intro is_ntcfI')
     show "vfsequence (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-))" unfolding ntcf_Hom_def by simp
     show "vcard (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)) = 5\<^sub>\<nat>"
       unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
     from assms category_axioms show 
       "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-) : op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (cs_concl cs_intro: cat_cs_intros)
     from assms category_axioms show 
       "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-) : op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (cs_concl cs_intro: cat_cs_intros)
     from assms show "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
       if "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>" for ab 
     proof-
       from that obtain a b
         where ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" 
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
         by 
           (
             rule cat_prod_2_ObjE[
               OF \<phi>.NTDom.HomDom.category_op \<psi>.NTDom.HomDom.category_axioms
               ]
           )
       from category_axioms assms a b show 
         "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> :
           Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub>
           Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ObjMap\<rparr>\<lparr>ab\<rparr>"
         unfolding ab_def cat_op_simps
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed
     show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a'b'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
        Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> =
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)\<lparr>ArrMap\<rparr>\<lparr>gf\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
         Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
       if "gf : ab \<mapsto>\<^bsub>op_cat \<AA> \<times>\<^sub>C \<BB>\<^esub> a'b'" for ab a'b' gf
     proof-
       from that obtain g f a b a' b'
         where gf_def: "gf = [g, f]\<^sub>\<circ>" 
           and ab_def: "ab = [a, b]\<^sub>\<circ>" 
           and a'b'_def: "a'b' = [a', b']\<^sub>\<circ>"
           and g: "g : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> a'"
           and f: "f : b \<mapsto>\<^bsub>\<BB>\<^esub> b'" 
         by 
           (
             elim 
               cat_prod_2_is_arrE[
                 OF \<phi>.NTDom.HomDom.category_op \<psi>.NTDom.HomDom.category_axioms
                 ]
           )
       from assms category_axioms that g f show ?thesis
         unfolding gf_def ab_def a'b'_def cat_op_simps
         by (*slow*)
           (
             cs_concl
               cs_simp: cat_ntcf_Hom_component_nat cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
     qed
   qed (auto simp: ntcf_Hom_components cat_cs_simps)
 
 qed
 
 lemma (in category) cat_ntcf_Hom_is_ntcf': 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<beta> = \<alpha>"
     and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,\<FF>'-)"
     and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<GG>'-)"
     and "\<CC>' = op_cat \<AA> \<times>\<^sub>C \<BB>"
     and "\<DD>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
   using assms(1-2) unfolding assms(3-7) by (rule cat_ntcf_Hom_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_Hom_is_ntcf'
 
 
 subsubsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with 
 two vertical compositions of natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_Hom_vcomp:
   assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<psi>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<HH>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<psi> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows 
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-) =
       Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-)"
 proof(rule ntcf_eqI[of \<alpha>])
 
   interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
   interpret \<psi>': is_ntcf \<alpha> \<BB> \<CC> \<GG>' \<HH>' \<psi>' by (rule assms(3))
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF>' \<GG>' \<psi> by (rule assms(4))
 
   from category_axioms assms show H_vcomp:
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<HH>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<HH>'-) :
       op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms show vcomp_H:
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<HH>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<HH>'-) :
       op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms H_vcomp have dom_H_vcomp:
     "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms H_vcomp have dom_vcomp_H:
     "\<D>\<^sub>\<circ> ((Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>) =
       (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
   show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr> =
     (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
     fix ab assume prems: "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" 
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by 
         ( 
           auto 
             elim: 
               cat_prod_2_ObjE[
                 OF \<phi>'.NTDom.HomDom.category_op \<psi>'.NTDom.HomDom.category_axioms
                 ]
             simp: cat_op_simps
         )
     from 
       assms a b
       category_axioms 
       \<phi>'.NTDom.HomDom.category_axioms
       \<psi>'.NTDom.HomDom.category_axioms 
     show
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,\<psi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi>-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> =
         (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,\<psi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,\<psi>-))\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
       by
         (
           cs_concl
             cs_simp: cat_cs_simps ab_def
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed (auto simp: ntcf_Hom_NTMap_vsv cat_cs_intros)
 
 qed simp_all
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_vcomp
 
 lemma (in category) cat_ntcf_Hom_ntcf_id:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF>': \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)"
 proof(rule ntcf_eqI[of \<alpha>])
 
   interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
   interpret \<FF>': is_functor \<alpha> \<BB> \<CC> \<FF>' by (rule assms(2))
 
   from category_axioms assms show H_id:
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
       op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms show id_H:
     "ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-) :
       op_cat \<AA> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
   from category_axioms assms H_id have dom_H_id:
     "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms H_id have dom_id_H:
     "\<D>\<^sub>\<circ> (ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
   show 
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr> =
       ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
     show "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>)" 
       by (rule ntcf_Hom_NTMap_vsv)
     from id_H show "vsv (ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>)"
       by (intro is_functor.ntcf_id_NTMap_vsv) 
         (cs_concl cs_simp: cs_intro: cat_cs_intros)
     fix ab assume "ab \<in>\<^sub>\<circ> (op_cat \<AA> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
     then obtain a b
       where ab_def: "ab = [a, b]\<^sub>\<circ>" 
         and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
         and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       by 
         ( 
           auto 
             elim: 
               cat_prod_2_ObjE[OF \<FF>.HomDom.category_op \<FF>'.HomDom.category_axioms]
             simp: cat_op_simps
         )
     from category_axioms assms a b H_id id_H show
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,ntcf_id \<FF>'-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr> = 
         ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,\<FF>'-)\<lparr>NTMap\<rparr>\<lparr>ab\<rparr>"
       unfolding ab_def
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_op_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed simp
 
 qed simp_all
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_ntcf_id
 
 
 
 subsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with a natural transformation
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See subsection 1.15 in \cite{bodo_categories_1970}.\<close>
 
 definition ntcf_lcomp_Hom :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/_-,-/')\<close>)
   where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,ntcf_id (cf_id (\<phi>\<lparr>NTDGCod\<rparr>))-)"
 
 definition ntcf_rcomp_Hom :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>'(/-,_-/')\<close>)
   where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id (cf_id (\<psi>\<lparr>NTDGCod\<rparr>))-,\<psi>-)"
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>)"
   unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
 
 lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>)"
   unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
 
 lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>) = (op_cat \<AA> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_lcomp_Hom_def \<phi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_rcomp_Hom_NTMap_vdomain[cat_cs_simps]:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>) = (op_cat \<CC> \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_rcomp_Hom_def \<psi>.ntcf_NTDGCod
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma ntcf_lcomp_Hom_NTMap_app[cat_cs_simps]:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_lcomp_Hom_component \<phi> a b"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   show ?thesis
     unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     using assms unfolding cat_op_simps
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_op_simps
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 lemma ntcf_rcomp_Hom_NTMap_app[cat_cs_simps]:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "a \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> = ntcf_rcomp_Hom_component \<psi> a b"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   show ?thesis
     unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     using assms unfolding cat_op_simps
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_op_simps 
           cs_intro: cat_cs_intros cat_prod_cs_intros
       )
 qed
 
 lemma (in category) ntcf_lcomp_Hom_NTMap_vrange:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def \<phi>.ntcf_NTDGCod
     by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 qed
 
 lemma (in category) ntcf_rcomp_Hom_NTMap_vrange:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-)\<lparr>NTMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Arr\<rparr>"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms show ?thesis
     unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def \<psi>.ntcf_NTDGCod
     by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
 qed
 
 
 subsubsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with 
 a natural transformation is a natural transformation
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf: 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) : op_cat \<AA> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms category_axioms show ?thesis
     unfolding 
       ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] \<phi>.ntcf_NTDGCod
     by (intro category.cat_ntcf_Hom_is_ntcf)
       (cs_concl cs_intro: cat_cs_intros)+
 qed
 
 lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf': 
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<beta> = \<alpha>"
     and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
     and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
     and "\<CC>' = op_cat \<AA> \<times>\<^sub>C \<CC>"
     and "\<DD>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
   using assms(1) unfolding assms(2-6) by (rule cat_ntcf_lcomp_Hom_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_is_ntcf'
 
 lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf:
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-) : op_cat \<CC> \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule assms(1))
   from assms category_axioms show ?thesis
     unfolding 
       ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] \<psi>.ntcf_NTDGCod
     by (intro category.cat_ntcf_Hom_is_ntcf)
       (cs_concl cs_intro: cat_cs_intros)+
 qed
 
 lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf':
   assumes "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<beta> = \<alpha>"
     and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-)"
     and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<GG>-)"
     and "\<CC>' = op_cat \<CC> \<times>\<^sub>C \<BB>"  
     and "\<DD>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<psi>-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>'"
   using assms(1) unfolding assms(2-6) by (rule cat_ntcf_rcomp_Hom_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_is_ntcf'
 
 
 subsubsection\<open>
 Component of a composition of a \<open>Hom\<close>-natural transformation 
 with a natural transformation and the Yoneda component
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows 
     "ntcf_lcomp_Hom_component \<phi> b c =
       Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) (\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>) c"
   (is \<open>?lcomp = ?Yc\<close>)
 proof-
 
   interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
 
   from assms(2) have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding cat_op_simps by clarsimp
   from b have \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     by (auto intro: cat_cs_intros)
   from assms(1,3) b category_axioms have \<phi>b:
     "\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>ObjMap\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
 
   have lcomp:
     "?lcomp : Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
     by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
   then have dom_lhs: "\<D>\<^sub>\<circ> (?lcomp\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
     by (cs_concl cs_simp: cat_cs_simps)  
 
   have Yc: "?Yc :
     Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     by 
       (
         rule cat_Yoneda_component_is_arr[
           OF cat_cf_Hom_snd_is_functor[OF \<FF>b] \<GG>b \<phi>b assms(3)
           ]
       )
   then have dom_rhs: "\<D>\<^sub>\<circ> (?Yc\<lparr>ArrVal\<rparr>) = Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
   
     from lcomp show "arr_Set \<alpha> ?lcomp" by (auto dest: cat_Set_is_arrD(1))
     from Yc show "arr_Set \<alpha> ?Yc" by (auto dest: cat_Set_is_arrD(1))
   
     show "?lcomp\<lparr>ArrVal\<rparr> = ?Yc\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       from assms(1) b category_axioms show "vsv (?Yc\<lparr>ArrVal\<rparr>)"
         by (intro is_functor.Yoneda_component_ArrVal_vsv)
           (cs_concl cs_intro: cat_cs_intros)
       show "?lcomp\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = ?Yc\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
         if "f \<in>\<^sub>\<circ> Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c" for f
       proof-
         from that have "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> c" by simp
         with category_axioms assms(1,3) b show ?thesis
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cat_op_simps 
                 cs_intro: cat_cs_intros cat_op_intros
             )
       qed
     qed (simp_all add: ntcf_lcomp_Hom_component_ArrVal_vsv)
     
     from Yc category_axioms assms(1,3) b have
       "?Yc : Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) c"
       by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
     with lcomp show "?lcomp\<lparr>ArrCod\<rparr> = ?Yc\<lparr>ArrCod\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
   
   qed (use lcomp Yc in \<open>cs_concl cs_simp: cat_cs_simps\<close>)
 
 qed
 
 
 subsubsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with 
 a vertical composition of natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
   assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>'-,-)"
 proof-
   interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
   from category_axioms have ntcf_id_cf_id:
     "ntcf_id (cf_id \<CC>) = ntcf_id (cf_id \<CC>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<CC>)"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms show ?thesis
     unfolding 
       ntcf_lcomp_Hom_def
       ntsmcf_vcomp_components 
       dghm_id_components 
       \<phi>'.ntcf_NTDGCod
       \<phi>.ntcf_NTDGCod
     by (subst ntcf_id_cf_id) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_vcomp
 
 lemma (in category) cat_ntcf_rcomp_Hom_vcomp:
   assumes "\<phi>' : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<phi>-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>'-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,\<phi>-)"
 proof-
   interpret \<phi>': is_ntcf \<alpha> \<AA> \<CC> \<GG> \<HH> \<phi>' by (rule assms(1))
   interpret \<phi>: is_ntcf \<alpha> \<AA> \<CC> \<FF> \<GG> \<phi> by (rule assms(2))
   from category_axioms have ntcf_id_cf_id:
     "ntcf_id (cf_id \<CC>) = ntcf_id (cf_id \<CC>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_id (cf_id \<CC>)"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from category_axioms assms show ?thesis
     unfolding 
       ntcf_rcomp_Hom_def
       ntsmcf_vcomp_components 
       dghm_id_components 
       \<phi>'.ntcf_NTDGCod
       \<phi>.ntcf_NTDGCod
     by (subst ntcf_id_cf_id) 
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_vcomp
 
 
 subsubsection\<open>
 Composition of a \<open>Hom\<close>-natural transformation with an identity natural 
 transformation
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(ntcf_id \<FF>-,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
 proof-
   interpret \<FF>: is_functor \<alpha> \<AA> \<CC> \<FF> by (rule assms(1))
   from category_axioms assms show ?thesis
     unfolding ntcf_lcomp_Hom_def ntcf_id_components \<FF>.cf_HomCod
     by
       (
         cs_concl
           cs_simp: ntcf_lcomp_Hom_def cat_cs_simps 
           cs_intro: cat_cs_intros
       )
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_id
 
 lemma (in category) cat_ntcf_rcomp_Hom_ntcf_id:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(-,ntcf_id \<FF>-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<FF>-)"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   from category_axioms assms show ?thesis
     unfolding ntcf_rcomp_Hom_def ntcf_id_components \<FF>.cf_HomCod
     by (cs_concl cs_simp: ntcf_rcomp_Hom_def cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_ntcf_id
 
 
 
 subsection\<open>Projections of a \<open>Hom\<close>-natural transformation\<close>
 
 
 text\<open>
 The concept of a projection of a \<open>Hom\<close>-natural transformation appears 
 in the corollary to the Yoneda Lemma in Chapter III-2 in 
 \cite{mac_lane_categories_2010} (although the concept has not been given
 any specific name in the aforementioned reference).
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition ntcf_Hom_snd :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>_'(/_,-/')\<close>)
   where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) =
     Yoneda_arrow \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>,-)) (\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>) f"
 
 definition ntcf_Hom_fst :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V" (\<open>Hom\<^sub>A\<^sub>.\<^sub>C\<index>_'(/-,_/')\<close>)
   where "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(f,-)"
 
 
 text\<open>Components.\<close>
 
 lemma (in category) cat_ntcf_Hom_snd_components:
   assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTMap\<rparr> = 
     (\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r f d)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGDom\<rparr> = \<CC>"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
 proof-
   interpret is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<close>
     using assms category_axioms by (cs_concl cs_simp: cs_intro: cat_cs_intros)
   show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTMap\<rparr> =
     (\<lambda>d\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r f d)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGDom\<rparr> = \<CC>"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
     unfolding ntcf_Hom_snd_def cat_is_arrD[OF assms] Yoneda_arrow_components
     by simp_all
 qed
 
 lemma (in category) cat_ntcf_Hom_fst_components:
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTMap\<rparr> =
     (\<lambda>d\<in>\<^sub>\<circ>op_cat \<CC>\<lparr>Obj\<rparr>. Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r f d)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDGDom\<rparr> = op_cat \<CC>"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
   using category_axioms assms
   unfolding 
     ntcf_Hom_fst_def
     category.cat_ntcf_Hom_snd_components[
       OF category_op, unfolded cat_op_simps, OF assms
       ]
     cat_op_simps
   by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+
 
 
 text\<open>Alternative definition.\<close>
 
 lemma (in category) ntcf_Hom_snd_def':
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = Yoneda_arrow \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)) s f"
   using assms unfolding ntcf_Hom_snd_def by (simp add: cat_cs_simps) 
 
 lemma (in category) ntcf_Hom_fst_def':
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) = Yoneda_arrow \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r f"
 proof-
   from assms category_axioms show ?thesis
     unfolding ntcf_Hom_fst_def ntcf_Hom_snd_def cat_op_simps
     by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
 qed
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 context category
 begin
 
 context
   fixes s r f
   assumes f: "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
 begin
 
 mk_VLambda cat_ntcf_Hom_snd_components(1)[OF f]
   |vsv ntcf_Hom_snd_NTMap_vsv[intro]|
   |vdomain ntcf_Hom_snd_NTMap_vdomain|
   |app ntcf_Hom_snd_NTMap_app|
 
 end
 
 context
   fixes s r f
   assumes f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
 begin
 
 mk_VLambda cat_ntcf_Hom_fst_components(1)[OF f]
   |vsv ntcf_Hom_fst_NTMap_vsv[intro]|
   |vdomain ntcf_Hom_fst_NTMap_vdomain|
   |app ntcf_Hom_fst_NTMap_app|
 
 end
 
 end
 
 lemmas [cat_cs_simps] = 
   category.ntcf_Hom_snd_NTMap_vdomain
   category.ntcf_Hom_fst_NTMap_vdomain
 
 lemmas ntcf_Hom_snd_NTMap_app[cat_cs_simps] = 
   category.ntcf_Hom_snd_NTMap_app
   category.ntcf_Hom_fst_NTMap_app
 
 
 subsubsection\<open>
 \<open>Hom\<close>-natural transformation projections are natural transformations
 \<close>
 
 lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
   assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   note f = cat_is_arrD[OF assms]
   show ?thesis
     unfolding ntcf_Hom_snd_def f
   proof(rule category.cat_Yoneda_arrow_is_ntcf)
     from assms category_axioms show "f \<in>\<^sub>\<circ> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
   qed (intro category_axioms cat_cf_Hom_snd_is_functor f)+
 qed
 
 lemma (in category) cat_ntcf_Hom_snd_is_ntcf':
   assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
     and "\<beta> = \<alpha>"
     and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
     and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
     and "\<CC>' = \<CC>"
     and "\<DD>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
   using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_snd_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_Hom_snd_is_ntcf'
 
 lemma (in category) cat_ntcf_Hom_fst_is_ntcf:
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   from assms have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   from 
     category.cat_ntcf_Hom_snd_is_ntcf[
       OF category_op, 
       unfolded cat_op_simps, 
       OF assms, 
       unfolded cat_op_cat_cf_Hom_snd[OF r] cat_op_cat_cf_Hom_snd[OF s],
       folded ntcf_Hom_fst_def
       ]
   show ?thesis .
 qed
 
 lemma (in category) cat_ntcf_Hom_fst_is_ntcf':
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
     and "\<beta> = \<alpha>"
     and "\<AA>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r)"
     and "\<BB>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)"
     and "\<CC>' = op_cat \<CC>"
     and "\<DD>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) : \<AA>' \<mapsto>\<^sub>C\<^sub>F \<BB>' : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>'"
   using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_fst_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_ntcf_Hom_fst_is_ntcf'
 
 
 subsubsection\<open>Opposite \<open>Hom\<close>-natural transformation projections\<close>
 
 lemma (in category) cat_op_cat_ntcf_Hom_snd: 
   "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)"
   unfolding ntcf_Hom_fst_def by simp
 
 lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_snd
 
 lemma (in category) cat_op_cat_ntcf_Hom_fst:
   "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<CC>(-,f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
   unfolding ntcf_Hom_fst_def cat_op_simps by simp
 
 lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst
 
 
 subsubsection\<open>
 \<open>Hom\<close>-natural transformation projections and the Yoneda component
 \<close>
 
 lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
   assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows 
     "Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
       Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) c g d =
       Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d"
     (is \<open>?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d = ?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<close>)
 proof-
 
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   note gD = cat_is_arrD[OF assms(1)]
   note fD = cat_is_arrD[OF assms(2)]
 
   from assms category_axioms have Y_f:
     "?Ya b f d : Hom \<CC> b d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a d"
     by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
   moreover from assms category_axioms have Y_g: 
     "?Yb c g d : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> b d"
     by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
   ultimately have Yf_Yg: 
     "?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a d"
     by (auto intro: cat_cs_intros)
   from assms category_axioms have Y_gf: 
     "?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> a d"
     by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
   from Yf_Yg have dom_rhs: 
     "\<D>\<^sub>\<circ> ((?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
     by (cs_concl cs_simp: cat_cs_simps)
   from Y_gf have dom_lhs: "\<D>\<^sub>\<circ> (?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"  
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
     from Yf_Yg show arr_Set_Yf_Yg: 
       "arr_Set \<alpha> (?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)"
       by (auto dest: cat_Set_is_arrD(1))
     interpret Yf_Yg: arr_Set \<alpha> \<open>?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d\<close>
       by (rule arr_Set_Yf_Yg)
     from Y_gf show arr_Set_Y_gf: "arr_Set \<alpha> (?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d)"
       by (auto dest: cat_Set_is_arrD(1))
     interpret Yf_Yg: arr_Set \<alpha> \<open>?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<close> by (rule arr_Set_Y_gf)
     show
       "(?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr> =
         ?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
       fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
       with Y_gf Y_g Y_f category_axioms assms show 
         "(?Ya b f d \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?Yb c g d)\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> =
           ?Ya c (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) d\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
         (*slow*)
         by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
     qed auto
   
   qed (use Y_gf Yf_Yg in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 lemmas [cat_cs_simps] = 
   category.cat_Yoneda_component_cf_Hom_snd_Comp[symmetric]
 
 lemma (in category) cat_Yoneda_component_cf_Hom_snd_CId:
   assumes "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows 
     "Yoneda_component Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) d = 
       cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>"
   (is \<open>?Ycd = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<close>)
 proof-
 
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   from assms category_axioms have Y_CId_c: 
     "?Ycd : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> c d"
     by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
   from Y_CId_c Set.category_axioms assms category_axioms have CId_cd:
     "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr> : Hom \<CC> c d \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> c d"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from Y_CId_c have dom_lhs: "\<D>\<^sub>\<circ> (?Ycd\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"  
     by (cs_concl cs_simp: cat_cs_simps)
   from CId_cd have dom_rhs: "\<D>\<^sub>\<circ> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> c d"
     by (cs_concl cs_simp: cat_cs_simps)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
     from Y_CId_c show arr_Set_Y_CId_c: "arr_Set \<alpha> ?Ycd"
       by (auto dest: cat_Set_is_arrD(1))
     interpret Yf_Yg: arr_Set \<alpha> ?Ycd by (rule arr_Set_Y_CId_c)
     from CId_cd show arr_Set_CId_cd: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>)"
       by (auto dest: cat_Set_is_arrD(1))
     interpret CId_cd: arr_Set \<alpha> \<open>cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<close>
       by (rule arr_Set_CId_cd)
     show "?Ycd\<lparr>ArrVal\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
       fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> d"
       with CId_cd Y_CId_c category_axioms assms show 
         "?Ycd\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>Hom \<CC> c d\<rparr>\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
     qed auto
   qed (use Y_CId_c CId_cd in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId
 
 
 subsubsection\<open>\<open>Hom\<close>-natural transformation projection of a composition\<close>
 
 lemma (in category) cat_ntcf_Hom_snd_Comp:
   assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-)"
   (is \<open>?H_gf = ?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g\<close>)
 proof(rule ntcf_eqI[of \<alpha>])
   from assms category_axioms show 
     "?H_gf : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms show "?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms have lhs_dom: "\<D>\<^sub>\<circ> (?H_gf\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms have rhs_dom:
     "\<D>\<^sub>\<circ> ((?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show "?H_gf\<lparr>NTMap\<rparr> = (?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
     fix d assume "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     with assms category_axioms show 
       "?H_gf\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = (?H_f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_g)\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed (use assms in \<open>auto intro: cat_cs_intros\<close>)
 qed auto
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp
 
 lemma (in category) cat_ntcf_Hom_fst_Comp:
   assumes "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)"
 proof-
   note category.cat_ntcf_Hom_snd_Comp[
       OF category_op, unfolded cat_op_simps, OF assms(2,1)
       ]
   from this category_axioms assms show ?thesis
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_Comp
 
 
 subsubsection\<open>\<open>Hom\<close>-natural transformation projection of an identity\<close>
 
 lemma (in category) cat_ntcf_Hom_snd_CId:
   assumes "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)"
   (is \<open>?H_c = ?id_H_c\<close>)
 proof(rule ntcf_eqI[of \<alpha>])
   from assms have "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c" by (auto simp: cat_cs_intros)
   from assms category_axioms show 
     "?H_c : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms show 
     "?id_H_c : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms have lhs_dom: "\<D>\<^sub>\<circ> (?H_c\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms category_axioms have rhs_dom: "\<D>\<^sub>\<circ> (?id_H_c\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   show "?H_c\<lparr>NTMap\<rparr> = ?id_H_c\<lparr>NTMap\<rparr>"
   proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
     from assms category_axioms show "vsv (?id_H_c\<lparr>NTMap\<rparr>)"
       by (intro is_functor.ntcf_id_NTMap_vsv) 
         (cs_concl cs_simp: cs_intro: cat_cs_intros)
     fix d assume "d \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     with assms category_axioms show "?H_c\<lparr>NTMap\<rparr>\<lparr>d\<rparr> = ?id_H_c\<lparr>NTMap\<rparr>\<lparr>d\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
   qed (use assms in \<open>auto intro: cat_cs_intros\<close>)
 qed auto
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId
 
 lemma (in category) cat_ntcf_Hom_fst_CId:
   assumes "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,c)"
 proof-
   note category.cat_ntcf_Hom_snd_CId[
       OF category_op, unfolded cat_op_simps, OF assms
       ]
   from this category_axioms assms show ?thesis
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_CId
 
 
 subsubsection\<open>\<open>Hom\<close>-natural transformation and the Yoneda map\<close>
 
 lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
   assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
   shows "Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr> = f"
   using category_axioms assms (*slow*)
   by
     (
       cs_concl
         cs_simp: cat_cs_simps cat_op_simps 
         cs_intro: cat_cs_intros cat_prod_cs_intros
     ) 
 
 lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_snd
 
 lemma (in category) cat_Yoneda_map_of_ntcf_Hom_fst:
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
   shows "Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s)) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<rparr> = f"
 proof-
   note category.cat_Yoneda_map_of_ntcf_Hom_snd[
       OF category_op, unfolded cat_op_simps, OF assms
       ]
   from this category_axioms assms show ?thesis
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
 qed
 
 lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_fst
 
 
 
 subsection\<open>Evaluation arrow\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The evaluation arrow is a part of the definition of the evaluation functor.
 The evaluation functor appears in Chapter III-2 in
 \cite{mac_lane_categories_2010}.
 \<close>
 
 definition cf_eval_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_eval_arrow \<CC> \<NN> f =
     [
       (
         \<lambda>x\<in>\<^sub>\<circ>\<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>.
           \<NN>\<lparr>NTCod\<rparr>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>
       ),
       \<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>,
       \<NN>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_eval_arrow_components:
   shows "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrVal\<rparr> =
     (
       \<lambda>x\<in>\<^sub>\<circ>\<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>.
         \<NN>\<lparr>NTCod\<rparr>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>x\<rparr>\<rparr>
     )"
     and "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrDom\<rparr> = \<NN>\<lparr>NTDom\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr>"
     and "cf_eval_arrow \<CC> \<NN> f\<lparr>ArrCod\<rparr> = \<NN>\<lparr>NTCod\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<CC>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
   unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<NN> \<CC> \<FF> \<GG> a b f  
   assumes \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
 begin
 
 interpretation \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule \<NN>)
 
 lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
     where \<CC>=\<CC> and \<NN>=\<open>ntcf_arrow \<NN>\<close> and f=f, 
     unfolded 
       ntcf_arrow_components 
       cf_map_components 
       \<NN>.NTDom.HomDom.cat_is_arrD[OF f]
       cat_cs_simps
     ]
 
 lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)
 
 end
 
 
 subsubsection\<open>Arrow value\<close>
 
 context
   fixes \<alpha> \<NN> \<CC> \<FF> \<GG> a b f  
   assumes \<NN>: "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
 begin
 
 mk_VLambda cf_eval_arrow_components'(1)[OF \<NN> f]
   |vsv cf_eval_arrow_ArrVal_vsv[cat_cs_intros]|
   |vdomain cf_eval_arrow_ArrVal_vdomain[cat_cs_simps]|
   |app cf_eval_arrow_ArrVal_app[cat_cs_simps]|
 
 end
 
 
 subsubsection\<open>Evaluation arrow is an arrow in the category \<open>Set\<close>\<close>
 
 lemma cf_eval_arrow_is_arr:
   assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f :
     \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
 proof-
   interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms)
   show ?thesis
   proof
     (
       intro cat_Set_is_arrI arr_SetI, 
       unfold cf_eval_arrow_components'(2,3)[OF assms]
     )
     show "vfsequence (cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f)"
       unfolding cf_eval_arrow_def by simp
     show "vcard (cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f) = 3\<^sub>\<nat>"
       unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by 
       (
         unfold cf_eval_arrow_components'[OF assms], 
         intro vrange_VLambda_vsubset
       ) 
       (
         use assms in 
           \<open>cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros\<close>
       )+
   qed
     (
       use assms(2) in
         \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
     )+
 qed
 
 lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
   assumes "\<NN>' = ntcf_arrow \<NN>"
     and "\<FF>a = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<GG>b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" 
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "cf_eval_arrow \<CC> \<NN>' f : \<FF>a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<GG>b"
   using assms(4,5) unfolding assms(1-3) by (rule cf_eval_arrow_is_arr)
 
 lemma (in category) cat_cf_eval_arrow_ntcf_vcomp[cat_cs_simps]:
   assumes "\<MM> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" 
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows 
     "cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) =
       cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
       cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f"
 proof-
 
   interpret \<MM>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> \<HH> \<MM> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(2))
 
   have \<MM>\<NN>: "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(3,4) have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from \<MM>\<NN> gf have cf_eval_gf:
     "cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) :
       \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   from assms(3,4) have cf_eval_g_cf_eval_f:
     "cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
       cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f :
       \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<HH>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   note cf_eval_gf = cf_eval_gf cat_Set_is_arrD[OF cf_eval_gf]
   note cf_eval_g_cf_eval_f = 
     cf_eval_g_cf_eval_f cat_Set_is_arrD[OF cf_eval_g_cf_eval_f]
 
   interpret arr_Set_cf_eval_gf:
     arr_Set \<alpha> \<open>cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<close>
     by (rule cf_eval_gf(2))
   interpret arr_Set_cf_eval_g_cf_eval_f:
     arr_Set 
       \<alpha> 
       \<open>
         cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
         cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
       \<close>
     by (rule cf_eval_g_cf_eval_f(2))
 
   show ?thesis
   proof(rule arr_Set_eqI)
     from \<MM>\<NN> gf have dom_lhs:
       "\<D>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr>) = 
         \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     from cf_eval_g_cf_eval_f(1) have dom_rhs: 
       "\<D>\<^sub>\<circ>
         (
           (
             cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
             cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
           )\<lparr>ArrVal\<rparr>
         ) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     show
       "cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr> =
         (
           cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
           cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
         )\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix \<FF>a assume prems: "\<FF>a \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       from 
         ArrVal_eq_helper
           [
             OF \<MM>.ntcf_Comp_commute[OF assms(4), symmetric], 
             where a=\<open>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<close>
           ] 
         prems 
         assms(3,4) 
       have [cat_cs_simps]:
         "\<HH>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<rparr>\<rparr> =
           \<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>\<rparr>\<rparr>"
         by
           (
             cs_prems
               cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
           )
       from prems assms(3,4) show 
         "cf_eval_arrow \<CC> (ntcf_arrow (\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)) (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f)\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr> =
           (
             cf_eval_arrow \<CC> (ntcf_arrow \<MM>) g \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
             cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f
           )\<lparr>ArrVal\<rparr>\<lparr>\<FF>a\<rparr>"
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
           )
     qed (cs_concl cs_intro: V_cs_intros)
   qed
     (
       auto
         simp: cf_eval_gf cf_eval_g_cf_eval_f 
         intro: cf_eval_gf(2) cf_eval_g_cf_eval_f(2)
     )
 
 qed
 
 lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_vcomp
 
 lemma (in category) cat_cf_eval_arrow_ntcf_id[cat_cs_simps]:
   assumes "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows 
     "cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) =
       cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
 proof-
 
   interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms)
 
   from assms(2) have ntcf_id_CId_c: 
     "cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) :
       \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     by (cs_concl cs_intro: cat_cs_intros)
   from assms(2) have CId_\<FF>c:
     "cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     by (cs_concl cs_intro: cat_cs_intros)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<alpha>])
 
     from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
       "arr_Set \<alpha> (cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>))"
       by (auto dest: cat_Set_is_arrD(1))
     from ntcf_id_CId_c have dom_lhs:
       "\<D>\<^sub>\<circ> (cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr>) =
         \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)+
     interpret ntcf_id_CId_c: 
       arr_Set \<alpha> \<open>cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<close>
       by (rule arr_Set_ntcf_id_CId_c)
   
     from CId_\<FF>c show arr_Set_CId_\<FF>c: "arr_Set \<alpha> (cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
       by (auto dest: cat_Set_is_arrD(1))
     from CId_\<FF>c assms(2) have dom_rhs: 
       "\<D>\<^sub>\<circ> ((cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)\<lparr>ArrVal\<rparr>) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>" 
       by (cs_concl cs_simp: cat_cs_simps)
 
     show 
       "cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr> =
         cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
       with category_axioms assms(2) show 
         "cf_eval_arrow \<CC> (ntcf_arrow (ntcf_id \<FF>)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>a\<rparr> =
           cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_\<FF>c in auto)
 
   qed (use ntcf_id_CId_c CId_\<FF>c in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id
 
 
 
 subsection\<open>\<open>HOM\<close>-functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The following definition is a technical generalization that is used
 later in this section.
 \<close>
 
 definition cf_HOM_snd :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>HOM\<^sub>C\<index>'(/,_-/')\<close>)
   where "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) =
     [
       (\<lambda>a\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(a,-) \<circ>\<^sub>C\<^sub>F \<FF>)),
       (
         \<lambda>f\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
           ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)
       ),
       op_cat (\<FF>\<lparr>HomCod\<rparr>),
       cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)
     ]\<^sub>\<circ>"
 
 definition cf_HOM_fst :: "V \<Rightarrow> V \<Rightarrow> V" (\<open>HOM\<^sub>C\<index>'(/_-,/')\<close>)
   where "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) =
     [
       (\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<FF>)),
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
           ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<FF>)
       ),
       \<FF>\<lparr>HomCod\<rparr>,
       cat_FUNCT \<alpha> (op_cat (\<FF>\<lparr>HomDom\<rparr>)) (cat_Set \<alpha>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_HOM_snd_components:
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr> =
       (\<lambda>a\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(a,-) \<circ>\<^sub>C\<^sub>F \<FF>))"
     and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr> =
       (
         \<lambda>f\<in>\<^sub>\<circ>op_cat (\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
           ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>)
       )"
     and [cat_cs_simps]: "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>HomDom\<rparr> = op_cat (\<FF>\<lparr>HomCod\<rparr>)"
     and [cat_cs_simps]: 
       "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)"
   unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 lemma cf_HOM_fst_components:
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ObjMap\<rparr> = 
       (\<lambda>a\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,a) \<circ>\<^sub>C\<^sub>F op_cf \<FF>))"
     and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ArrMap\<rparr> = 
       (
         \<lambda>f\<in>\<^sub>\<circ>(\<FF>\<lparr>HomCod\<rparr>)\<lparr>Arr\<rparr>.
           ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>\<lparr>HomCod\<rparr>)(-,f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<FF>)
       )"
     and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
     and "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> (op_cat (\<FF>\<lparr>HomDom\<rparr>)) (cat_Set \<alpha>)"
   unfolding cf_HOM_fst_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 context is_functor
 begin
 
 lemmas cf_HOM_snd_components' = 
   cf_HOM_snd_components[where \<FF>=\<FF>, unfolded cf_HomDom cf_HomCod]
 
 lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
 
 lemmas cf_HOM_fst_components' = 
   cf_HOM_fst_components[where \<FF>=\<FF>, unfolded cf_HomDom cf_HomCod]
 
 lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda cf_HOM_snd_components(1)
   |vsv cf_HOM_snd_ObjMap_vsv[cat_cs_intros]|
 
 mk_VLambda (in is_functor) cf_HOM_snd_components'(1)[unfolded cat_op_simps]
   |vdomain cf_HOM_snd_ObjMap_vdomain[cat_cs_simps]|
   |app cf_HOM_snd_ObjMap_app[cat_cs_simps]|
 
 mk_VLambda cf_HOM_snd_components(1)
   |vsv cf_HOM_fst_ObjMap_vsv[cat_cs_intros]|
 
 mk_VLambda (in is_functor) cf_HOM_fst_components'(1)[unfolded cat_op_simps]
   |vdomain cf_HOM_fst_ObjMap_vdomain[cat_cs_simps]|
   |app cf_HOM_fst_ObjMap_app[cat_cs_simps]|
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda cf_HOM_snd_components(2)
   |vsv cf_HOM_snd_ArrMap_vsv[cat_cs_intros]|
 
 mk_VLambda (in is_functor) cf_HOM_snd_components'(2)[unfolded cat_op_simps]
   |vdomain cf_HOM_snd_ArrMap_vdomain[cat_cs_simps]|
   |app cf_HOM_snd_ArrMap_app[cat_cs_simps]|
 
 mk_VLambda cf_HOM_fst_components(2)
   |vsv cf_HOM_fst_ArrMap_vsv[cat_cs_intros]|
 
 mk_VLambda (in is_functor) cf_HOM_fst_components'(2)[unfolded cat_op_simps]
   |vdomain cf_HOM_fst_ArrMap_vdomain[cat_cs_simps]|
   |app cf_HOM_fst_ArrMap_app[cat_cs_simps]|
 
 
 subsubsection\<open>Opposite \<open>HOM\<close>-functor\<close>
 
 lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]: 
   "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-) = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)"
 proof-
   have dom_lhs: "\<D>\<^sub>\<circ> HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-) = 4\<^sub>\<nat>"
     unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) = 4\<^sub>\<nat>"
     unfolding cf_HOM_fst_def by (simp add: nat_omega_simps)
   show ?thesis
   proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
     fix a assume "a \<in>\<^sub>\<circ> 4\<^sub>\<nat>"
     then show "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>a\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>a\<rparr>"
     proof
       (
         elim_in_numeral, 
         use nothing in \<open>fold dghm_field_simps, unfold cat_cs_simps\<close>
       )
       show "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>ObjMap\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ObjMap\<rparr>"
         unfolding 
           cf_HOM_fst_components' 
           is_functor.cf_HOM_snd_components'[OF is_functor_op]
         by (rule VLambda_eqI, unfold cat_op_simps)
          (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)+
       show "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,op_cf \<FF>-)\<lparr>ArrMap\<rparr> = HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,)\<lparr>ArrMap\<rparr>"
         unfolding 
           cf_HOM_fst_components' 
           is_functor.cf_HOM_snd_components'[OF is_functor_op]
         by (rule VLambda_eqI, unfold cat_op_simps)
           (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+ 
     qed 
       (
         auto simp:
           cf_HOM_fst_components' cat_cs_simps cat_op_simps cat_op_intros
       )
   qed (auto simp: cf_HOM_snd_def cf_HOM_fst_def)
 qed
 
 lemmas [cat_op_simps] = is_functor.cf_HOM_snd_op
 
 context is_functor
 begin
 
 lemmas cf_HOM_fst_op[cat_op_simps] = 
   is_functor.cf_HOM_snd_op[OF is_functor_op, unfolded cat_op_simps, symmetric]
 
 end
 
 lemmas [cat_op_simps] = is_functor.cf_HOM_fst_op
 
 
 subsubsection\<open>\<open>HOM\<close>-functor is a functor\<close>
 
 lemma (in is_functor) cf_HOM_snd_is_functor: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)"
 proof-
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<CC>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
   show ?thesis
   proof(intro is_functorI', unfold cat_op_simps)
     show "vfsequence HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)" unfolding cf_HOM_snd_def by auto
     show "vcard HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) = 4\<^sub>\<nat>"
       unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
       unfolding cf_HOM_snd_components'
     proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
       fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       with assms(2) show 
         "cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(b,-) \<circ>\<^sub>C\<^sub>F \<FF>) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
         by
           (
             cs_concl
               cs_simp: cat_FUNCT_cs_simps 
               cs_intro: cat_cs_intros cat_FUNCT_cs_intros
           )
     qed
     show 
       "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> g\<rparr> = 
         HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<^esub>
         HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "g : c \<mapsto>\<^bsub>\<BB>\<^esub> b" and "f : b \<mapsto>\<^bsub>\<BB>\<^esub> a" for b c g a f
       using that 
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     show 
       "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ArrMap\<rparr>\<lparr>\<BB>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> =
         cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<lparr>CId\<rparr>\<lparr>HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       if "c \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for c 
       using that
       by
         (
           cs_concl
             cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
   qed 
     (
       use assms(2) in
         \<open>
           cs_concl
             cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
             cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
         \<close>
     )+
 
 qed
 
 lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<CC>' = op_cat \<BB>"
     and "\<DD> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)"
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-) : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>"
   using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_snd_is_functor)
 
 lemmas [cat_cs_intros] = is_functor.cf_HOM_snd_is_functor'
 
 lemma (in is_functor) cf_HOM_fst_is_functor: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> (op_cat \<AA>) (cat_Set \<alpha>)"
   by 
     (
       rule is_functor.cf_HOM_snd_is_functor[
         OF is_functor_op assms, unfolded cat_op_simps
         ]
    )
 
 lemma (in is_functor) cf_HOM_fst_is_functor'[cat_cs_intros]: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<CC>' = \<BB>"
     and "\<DD> = cat_FUNCT \<alpha> (op_cat \<AA>) (cat_Set \<alpha>)"
   shows "HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(\<FF>-,) : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<DD>"
   using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_fst_is_functor)
 
 lemmas [cat_cs_intros] = is_functor.cf_HOM_fst_is_functor'
 
 
 
 subsection\<open>Evaluation functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_eval :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_eval \<alpha> \<beta> \<CC> =
     [
       (\<lambda>\<FF>d\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<FF>d\<lparr>0\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<FF>d\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>),
       (
         \<lambda>\<NN>f\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
           cf_eval_arrow \<CC> (\<NN>f\<lparr>0\<rparr>) (\<NN>f\<lparr>1\<^sub>\<nat>\<rparr>)
       ),
       cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>,
       cat_Set \<beta>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma cf_eval_components:
   shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr> =
     (\<lambda>\<FF>d\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. \<FF>d\<lparr>0\<rparr>\<lparr>ObjMap\<rparr>\<lparr>\<FF>d\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>)"
     and "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr> =
       (
         \<lambda>\<NN>f\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>.
           cf_eval_arrow \<CC> (\<NN>f\<lparr>0\<rparr>) (\<NN>f\<lparr>1\<^sub>\<nat>\<rparr>)
       )"
     and [cat_cs_simps]: 
       "cf_eval \<alpha> \<beta> \<CC>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
     and [cat_cs_simps]: "cf_eval \<alpha> \<beta> \<CC>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
   unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>)"
   unfolding cf_eval_components by simp
 
 lemma cf_eval_ObjMap_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>) = (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
   unfolding cf_eval_components by simp
 
 lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]: 
   assumes "\<FF>c = [cf_map \<FF>, c]\<^sub>\<circ>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" (*the order of premises is important*)
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(2))
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
   note [cat_small_cs_intros] = cat_category_if_ge_Limit
   from assms(2,3) \<alpha>\<beta> have "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: assms(1) cat_FUNCT_components(1)
           cs_intro: 
             cat_cs_intros 
             cat_small_cs_intros 
             cat_prod_cs_intros 
             cat_FUNCT_cs_intros
       )
   then show ?thesis
     by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
 qed
 
 lemmas [cat_cs_simps] = category.cf_eval_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>)"
   unfolding cf_eval_components by simp
 
 lemma cf_eval_ArrMap_vdomain[cat_cs_simps]: 
   "\<D>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>) = (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
   unfolding cf_eval_components by simp
 
 lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]: 
   assumes "\<NN>f = [ntcf_arrow \<NN>, f]\<^sub>\<circ>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   shows "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> = cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f"
 proof-
   interpret \<FF>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(2))
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
   note [cat_small_cs_intros] = cat_category_if_ge_Limit
   from assms(1,3) \<alpha>\<beta> have "\<NN>f \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Arr\<rparr>"
     by 
       (
         cs_concl
           cs_simp: assms(1) cat_FUNCT_components(1)
           cs_intro: 
             cat_cs_intros 
             cat_small_cs_intros 
             cat_prod_cs_intros 
             cat_FUNCT_cs_intros
       )
   then show ?thesis
     by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
 qed
 
 lemmas [cat_cs_simps] = category.cf_eval_ArrMap_app
 
 
 subsubsection\<open>Evaluation functor is a functor\<close>
 
 lemma (in category) cat_cf_eval_is_functor:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "cf_eval \<alpha> \<beta> \<CC> : cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT: 
     category \<beta> \<open>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))\<close>
     by 
       (
         cs_concl cs_intro:
           cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )
   interpret \<beta>\<CC>: category \<beta> \<CC>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
     by (rule subcategory_cat_Set_cat_Set[OF assms])
   
   show ?thesis
   proof(intro is_functorI')
     show "vfsequence (cf_eval \<alpha> \<beta> \<CC>)" unfolding cf_eval_def by simp
     from cat_category_if_ge_Limit[OF assms] show 
       "category \<beta> ((cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) \<times>\<^sub>C \<CC>)"
       by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_cs_intros)
     show "vcard (cf_eval \<alpha> \<beta> \<CC>) = 4\<^sub>\<nat>" 
       unfolding cf_eval_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
     proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
       fix \<FF>c assume prems: "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
       then obtain \<FF> c 
         where \<FF>c_def: "\<FF>c = [\<FF>, c]\<^sub>\<circ>"
           and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
           and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by 
           (
             auto 
               elim: cat_prod_2_ObjE[rotated 2] 
               intro: FUNCT.category_axioms \<beta>\<CC>.category_axioms
               simp: cat_FUNCT_components(1)
           )
       from \<FF> obtain \<GG> where \<FF>_def: "\<FF> = cf_map \<GG>"
         and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
         by (elim cf_mapsE)        
       interpret \<GG>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> by (rule \<GG>)
       from \<GG> c show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
         unfolding \<FF>c_def \<FF>_def 
         by 
           (
             cs_concl
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_Set_\<alpha>\<beta>.subcat_Obj_vsubset
           )
     qed (cs_concl cs_intro: cat_cs_intros)
     show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> :
       cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr>"
       if \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b" for \<FF>a \<GG>b \<NN>f
     proof-
       obtain \<NN> f \<FF> a \<GG> b
         where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>" 
           and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
           and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>" 
           and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>" 
           and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
         by 
           (
             auto intro: 
               cat_prod_2_is_arrE[rotated 2, OF \<NN>f] 
               FUNCT.category_axioms 
               \<beta>\<CC>.category_axioms
           )
       note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
       from \<NN>(1) f assms(2) show "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> :
         cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr>"
         unfolding \<NN>f_def \<FF>a_def \<GG>b_def
         by
           (
             intro cat_Set_\<alpha>\<beta>.subcat_is_arrD,
             use nothing in \<open>subst \<NN>(2), subst \<NN>(3), subst \<NN>(4)\<close>
           )
           (
             cs_concl
               cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros 
           ) (*slow*)
     qed
     show 
       "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<NN>f\<rparr> =
         cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr>"
       if \<MM>g: "\<MM>g : \<GG>b \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<HH>c"
         and \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b"
       for \<NN>f \<MM>g \<FF>a \<GG>b \<HH>c
     proof-
       obtain \<NN> f \<FF> a \<GG> b
         where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>" 
           and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
           and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>" 
           and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>" 
           and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
         by 
           (
             auto intro: 
               cat_prod_2_is_arrE[rotated 2, OF \<NN>f] 
               FUNCT.category_axioms 
               \<beta>\<CC>.category_axioms
           )
       then obtain \<MM> g \<HH> c
         where \<MM>g_def: "\<MM>g = [\<MM>, g]\<^sub>\<circ>" 
           and \<HH>c_def: "\<HH>c = [\<HH>, c]\<^sub>\<circ>" 
           and \<MM>: "\<MM> : \<GG> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<HH>"
           and g: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c"
         by 
           (
             auto intro: 
               cat_prod_2_is_arrE[rotated 2, OF \<MM>g] 
               FUNCT.category_axioms
               \<beta>\<CC>.category_axioms
           )
       note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
         and \<MM> = cat_FUNCT_is_arrD[OF \<MM>]
       from \<NN>(1) \<MM>(1) f g show
         "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g \<circ>\<^sub>A\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<NN>f\<rparr> =
           cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<MM>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr>"
         unfolding \<MM>g_def \<NN>f_def \<FF>a_def \<GG>b_def \<HH>c_def
         by 
           (
             subst (1 2) \<MM>(2), use nothing in \<open>subst (1 2) \<NN>(2)\<close>, 
             cs_concl_step cat_Set_\<alpha>\<beta>.subcat_Comp_simp[symmetric]
           )
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
           )
     qed
     show
       "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>c\<rparr>\<rparr> =
         cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr>\<rparr>"
       if "\<FF>c \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>c
     proof-
       from that obtain \<FF> c where \<FF>c_def: "\<FF>c = [\<FF>, c]\<^sub>\<circ>"
         and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
         and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by 
           (
             auto 
               elim: cat_prod_2_ObjE[rotated 2] 
               intro: FUNCT.category_axioms \<beta>\<CC>.category_axioms
               simp: cat_FUNCT_components(1)
           )
       from \<FF> obtain \<GG> where \<FF>_def: "\<FF> = cf_map \<GG>"
         and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
         by (elim cf_mapsE)
       interpret \<GG>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<GG> by (rule \<GG>)
       from \<GG> c show 
         "cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>CId\<rparr>\<lparr>\<FF>c\<rparr>\<rparr> =
           cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>c\<rparr>\<rparr>"
         unfolding \<FF>c_def \<FF>_def
         by (cs_concl_step cat_Set_\<alpha>\<beta>.subcat_CId[symmetric])
           (
             cs_concl
               cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
           )
     qed
 
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
 
 qed
 
 lemma (in category) cat_cf_eval_is_functor':
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<AA>' = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
     and "\<BB>' = cat_Set \<beta>"
     and "\<beta>' = \<beta>"
   shows "cf_eval \<alpha> \<beta> \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
   using assms(1,2) unfolding assms(3-5) by (rule cat_cf_eval_is_functor) 
 
 lemmas [cat_cs_intros] = category.cat_cf_eval_is_functor'
 
 
 
 subsection\<open>\<open>N\<close>-functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition cf_nt :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_nt \<alpha> \<beta> \<FF> =
     bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
       (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))"
 
 
 text\<open>Alternative definition.\<close>
 
 lemma (in is_functor) cf_nt_def':
   "cf_nt \<alpha> \<beta> \<FF> =
     bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
       (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))"
   unfolding cf_nt_def cf_HomDom cf_HomCod by simp
 
 
 text\<open>Components.\<close>
 
 lemma cf_nt_components:
   shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
     (
       bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
         (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
     )\<lparr>ObjMap\<rparr>"
     and "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
       (
         bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>ArrMap\<rparr>"
     and "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> =
       (
         bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>HomDom\<rparr>"
     and "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> =
       (
         bifunctor_flip (\<FF>\<lparr>HomCod\<rparr>) (cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>HomCod\<rparr>"
   unfolding cf_nt_def by simp_all
 
 lemma (in is_functor) cf_nt_components':
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
       (
         bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>ObjMap\<rparr>"
     and "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
       (
         bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>ArrMap\<rparr>"
     and [cat_cs_simps]: 
       "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
     and [cat_cs_simps]: 
       "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   show 
     "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr> =
       (
         bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>ObjMap\<rparr>"
     "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr> =
       (
         bifunctor_flip \<BB> (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
           (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)(HOM\<^sub>C\<^bsub>\<alpha>\<^esub>(,\<FF>-)-,-))
       )\<lparr>ArrMap\<rparr>"
     "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomDom\<rparr> = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
     "cf_nt \<alpha> \<beta> \<FF>\<lparr>HomCod\<rparr> = cat_Set \<beta>"
     unfolding cf_nt_def 
     using assms(2)
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
           cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )+
 qed
 
 lemmas [cat_cs_simps] = is_functor.cf_nt_components'(3,4)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>)"
   unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
 
 lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<D>\<^sub>\<circ> (cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>)\<lparr>Obj\<rparr>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   from assms(2) show ?thesis
     unfolding cf_nt_components
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
           cs_intro: 
             cat_small_cs_intros
             cat_cs_intros
             cat_FUNCT_cs_intros
             cat_prod_cs_intros
       )
 qed
 
 lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_vdomain
 
 lemma (in is_functor) cf_nt_ObjMap_app[cat_cs_simps]: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<GG>b = [cf_map \<GG>, b]\<^sub>\<circ>"
     and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<GG>b\<rparr> = Hom
     (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
     (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(b,-) \<circ>\<^sub>C\<^sub>F \<FF>))
     (cf_map \<GG>)"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<GG>: is_functor \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<GG> by (rule assms(4))
   from assms(2,5) show ?thesis
     unfolding assms(3) cf_nt_def
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps 
           cs_intro:
             cat_cs_intros
             cat_small_cs_intros
             cat_FUNCT_cs_intros
             cat_prod_cs_intros 
             cat_op_intros
       )
 qed
 
 lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>)"
   unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
 
 lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<D>\<^sub>\<circ> (cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>)\<lparr>Arr\<rparr>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   from assms(2) show ?thesis
     unfolding cf_nt_components
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
           cs_intro: 
             cat_small_cs_intros
             cat_cs_intros
             cat_FUNCT_cs_intros
             cat_prod_cs_intros
       )
 qed
 
 lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_vdomain
 
 lemma (in is_functor) cf_nt_ArrMap_app[cat_cs_simps]: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<NN>f = [ntcf_arrow \<NN>, f]\<^sub>\<circ>"
     and "\<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
   shows "cf_nt \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> = cf_hom
     (cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>))
     [ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<BB>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>), ntcf_arrow \<NN>]\<^sub>\<circ>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<NN>: is_ntcf \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<GG> \<HH> \<NN> by (rule assms(4))
   from assms(2,5) show ?thesis
     unfolding assms(3) cf_nt_def
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
           cs_intro:
             cat_cs_intros
             cat_small_cs_intros
             cat_FUNCT_cs_intros
             cat_prod_cs_intros
             cat_op_intros
       )
 qed
 
 lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_app
 
 
 subsubsection\<open>\<open>N\<close>-functor is a functor\<close>
 
 lemma (in is_functor) cf_nt_is_functor:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "cf_nt \<alpha> \<beta> \<FF> : cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<AA>: category \<beta> \<AA>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: category \<beta> \<BB>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   from assms(2) show ?thesis
     unfolding cf_nt_def'
     by 
       (
         cs_concl 
           cs_simp: cat_op_simps 
           cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
       )
 qed
 
 lemma (in is_functor) cf_nt_is_functor':
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<AA>' = cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>) \<times>\<^sub>C \<BB>"
     and "\<BB>' = cat_Set \<beta>"
     and "\<beta>' = \<beta>"
   shows "cf_nt \<alpha> \<beta> \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
   using assms(1,2) unfolding assms(3-5) by (rule cf_nt_is_functor) 
 
 lemmas [cat_cs_intros] = is_functor.cf_nt_is_functor'
 
 
 
 subsection\<open>Yoneda natural transformation arrow\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The following subsection is based on the elements of the content
 of Chapter III-2 in \cite{mac_lane_categories_2010}. 
 \<close>
 
 definition ntcf_Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r =
     [
       (
         \<lambda>\<psi>\<in>\<^sub>\<circ>Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>.
           Yoneda_map \<alpha> (cf_of_cf_map \<CC> (cat_Set \<alpha>) \<FF>) r\<lparr>
             ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<psi>
             \<rparr>
       ),
       Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>,
       \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components\<close>
 
 lemma ntcf_Yoneda_arrow_components:
   shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrVal\<rparr> = 
     (
       \<lambda>\<psi>\<in>\<^sub>\<circ>Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>.
         Yoneda_map \<alpha> (cf_of_cf_map \<CC> (cat_Set \<alpha>) \<FF>) r\<lparr>
           ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<psi>
           \<rparr>
     )"
     and [cat_cs_simps]: "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrDom\<rparr> = 
       Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-))) \<FF>"
     and [cat_cs_simps]: "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF> r\<lparr>ArrCod\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   unfolding ntcf_Yoneda_arrow_def arr_field_simps
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda ntcf_Yoneda_arrow_components(1)
   |vsv ntcf_Yoneda_arrow_vsv[cat_cs_intros]|
   |vdomain ntcf_Yoneda_arrow_vdomain[cat_cs_simps]|
 
 context category
 begin
 
 context
   fixes \<FF> :: V
 begin
 
 mk_VLambda ntcf_Yoneda_arrow_components(1)[where \<alpha>=\<alpha> and \<CC>=\<CC> and \<FF>=\<open>cf_map \<FF>\<close>]
   |app ntcf_Yoneda_arrow_app'|
 
 lemmas ntcf_Yoneda_arrow_app =
   ntcf_Yoneda_arrow_app'[unfolded in_Hom_iff, cat_cs_simps]
 
 end
 
 end
 
 lemmas [cat_cs_simps] = category.ntcf_Yoneda_arrow_app
 
 
 subsubsection\<open>Several technical lemmas\<close>
 
 lemma (in vsv) vsv_vrange_VLambda_app:
   assumes "g ` elts A = elts (\<D>\<^sub>\<circ> r)"
   shows "\<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>) = \<R>\<^sub>\<circ> r"
 proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
   show "(\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" if "x \<in>\<^sub>\<circ> A" for x
   proof-
     from assms that have "g x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
     then have "r\<lparr>g x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by force
     with that show ?thesis by simp
   qed
   show "r\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)" if "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" for x
   proof-
     from that assms have "x \<in> g ` elts A" by simp
     then obtain c where c: "c \<in>\<^sub>\<circ> A" and x_def: "x = g c" by clarsimp
     from c show ?thesis unfolding x_def by auto
   qed
 qed auto
 
 lemma (in vsv) vsv_vrange_VLambda_app':
   assumes "g ` elts A = elts (\<D>\<^sub>\<circ> r)"
     and "R = \<R>\<^sub>\<circ> r"
   shows "\<R>\<^sub>\<circ> (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>) = R"
   using assms(1) unfolding assms(2) by (rule vsv_vrange_VLambda_app)
 
 lemma (in v11) v11_VLambda_v11_bij_betw_comp:
   assumes "bij_betw g (elts A) (elts (\<D>\<^sub>\<circ> r))"
   shows "v11 (\<lambda>x\<in>\<^sub>\<circ>A. r\<lparr>g x\<rparr>)"
 proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
   fix x y assume prems: "x \<in>\<^sub>\<circ> A" "y \<in>\<^sub>\<circ> A" "r\<lparr>g x\<rparr> = r\<lparr>g y\<rparr>"
   from assms prems(1,2) have "g x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "g y \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
   from v11_injective[OF this prems(3)] have "g x = g y".
   with assms prems(1,2) show "x = y" unfolding bij_betw_def inj_on_def by simp
 qed simp
 
 
 subsubsection\<open>
 Yoneda natural transformation arrow is an arrow in the category \<open>Set\<close>
 \<close>
 
 lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r :
     Hom 
       (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
       (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
       (cf_map \<FF>) \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub>
     \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
 proof-
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms)
 
   from assms(2) interpret FUNCT: tiny_category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
 
   let ?Hom_r = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close>
 
   from assms have [cat_cs_simps]: "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map \<FF>) = \<FF>"
     by (cs_concl cs_simp: cat_FUNCT_cs_simps)
 
   note Yoneda = cat_Yoneda_Lemma[OF assms(3,4)]
 
   show ?thesis
   proof
     (
       intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
       unfold cat_cs_simps cf_map_components
     )
     show "vfsequence (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r)"
       unfolding ntcf_Yoneda_arrow_def by simp
     show "vcard (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r) = 3\<^sub>\<nat>"
       unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>) = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
       unfolding cat_cs_simps cf_map_components ntcf_Yoneda_arrow_components 
       by (intro vsv.vsv_vrange_VLambda_app', unfold Yoneda(2))
         (
           use assms(4) in
             \<open>
               cs_concl
                 cs_simp:
                   cat_cs_simps bij_betwD(2)[OF bij_betw_ntcf_of_ntcf_arrow_Hom]
                 cs_intro: cat_cs_intros
             \<close>
         )+
     then show "\<R>\<^sub>\<circ> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
       by auto
     from assms(4) show "v11 (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r\<lparr>ArrVal\<rparr>)"
       unfolding ntcf_Yoneda_arrow_components
       by 
         (
           intro v11.v11_VLambda_v11_bij_betw_comp, 
           unfold cat_cs_simps \<FF>.Yoneda_map_vdomain; 
           intro Yoneda bij_betw_ntcf_of_ntcf_arrow_Hom
         )
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(4) show 
       "Hom (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) (cf_map ?Hom_r) (cf_map \<FF>) \<in>\<^sub>\<circ> Vset \<beta>"
       by (intro FUNCT.cat_Hom_in_Vset)
         (
           cs_concl 
             cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     from assms(4) have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" 
       by (cs_concl cs_intro: cat_cs_intros)
     then show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
       by (auto simp: assms(2) Vset_trans Vset_in_mono)
   qed (auto intro: cat_cs_intros)
 
 qed
 
 lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism':
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<FF>' = cf_map \<FF>"
     and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     and "A = Hom 
       (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
       (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
       (cf_map \<FF>)"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF>' r : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> B"
   using assms(1,2,6,7) 
   unfolding assms(3-5)
   by (rule cat_ntcf_Yoneda_arrow_is_arr_isomoprhism)
 
 lemmas [cat_arrow_cs_intros] = 
   category.cat_ntcf_Yoneda_arrow_is_arr_isomoprhism'
 
 lemma (in category) cat_ntcf_Yoneda_arrow_is_arr:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r :
     Hom
       (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
       (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
       (cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
     \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
   by 
     (
       rule cat_Set_is_arr_isomorphismD[
         OF cat_ntcf_Yoneda_arrow_is_arr_isomoprhism[OF assms]
         ]
     )
 
 lemma (in category) cat_ntcf_Yoneda_arrow_is_arr'[cat_cs_intros]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<FF>' = cf_map \<FF>"
     and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     and "A = Hom 
       (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
       (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)))
       (cf_map \<FF>)"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_Yoneda_arrow \<alpha> \<CC> \<FF>' r : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> B"
   using assms(1,2,6,7) 
   unfolding assms(3-5)
   by (rule cat_ntcf_Yoneda_arrow_is_arr)
 
 lemmas [cat_arrow_cs_intros] = category.cat_ntcf_Yoneda_arrow_is_arr'
 
 
 subsection\<open>Commutativity law for the Yoneda natural transformation arrow\<close>
 
 lemma (in category) cat_ntcf_Yoneda_arrow_commutativity:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
   shows 
     "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
       cf_hom
         (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) 
         [ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-), ntcf_arrow \<NN>]\<^sub>\<circ> =
           cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
             ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a"
 proof-
 
   let ?hom = 
     \<open>
       cf_hom
         (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)) 
         [ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-), ntcf_arrow \<NN>]\<^sub>\<circ>
     \<close>
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> \<GG> \<NN> by (rule assms(3))
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
   interpret \<beta>\<CC>: category \<beta> \<CC>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
     by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
 
   from assms(2,4) have \<GG>b_\<NN>f:
     "ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom :
       Hom
         (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
         (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
         (cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
       \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     by
       (
         cs_concl
           cs_intro:
             cat_small_cs_intros
             cat_cs_intros
             cat_prod_cs_intros
             cat_op_intros
             cat_FUNCT_cs_intros
       )
 
   from assms(2,4) have \<NN>f_\<FF>a:
     "cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
       ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a :
       Hom
         (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
         (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
         (cf_map \<FF>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
       \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     by (cs_concl cs_intro: cat_cs_intros cat_Set_\<alpha>\<beta>.subcat_is_arrD)
 
   show ?thesis
   proof(rule arr_Set_eqI[of \<beta>])
 
     from \<GG>b_\<NN>f show arr_Set_\<GG>b_\<NN>f:
       "arr_Set \<beta> (ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)"
       by (auto dest: cat_Set_is_arrD(1))
     from \<GG>b_\<NN>f have dom_lhs: 
       "\<D>\<^sub>\<circ> ((ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr>) = 
         Hom
           (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
           (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
           (cf_map \<FF>)"
       by (cs_concl cs_simp: cat_cs_simps)+
     interpret \<NN>f_\<FF>a: arr_Set 
       \<beta> \<open>ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom\<close>
       by (rule arr_Set_\<GG>b_\<NN>f)
   
     from \<NN>f_\<FF>a show arr_Set_\<NN>f_\<FF>a:
       "arr_Set 
         \<beta> 
         (
           cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
           ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
         )"
       by (auto dest: cat_Set_is_arrD(1))
     from \<NN>f_\<FF>a have dom_rhs: 
       "\<D>\<^sub>\<circ> 
         (
           (
             cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
             ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
           )\<lparr>ArrVal\<rparr>
         ) = Hom
           (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>))
           (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)))
           (cf_map \<FF>)" 
       by (cs_concl cs_simp: cat_cs_simps)
 
     show 
       "(ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr> =
         (
           cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
           ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
         )\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
 
       fix \<MM> assume prems: 
         "\<MM> : cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> cf_map \<FF>"
 
       from assms(4) have [cat_cs_simps]:
         "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
         "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map \<FF>) = \<FF>"
         by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
 
       note \<MM> = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
 
       interpret \<MM>: is_ntcf 
         \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)\<close> \<FF> \<open>ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<MM>\<close>
         by (rule \<MM>(1))
 
       have \<GG>\<NN>_eq_\<NN>\<FF>:
         "\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>A\<rparr>\<rparr> =
           \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>A\<rparr>\<rparr>"
         if "A \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" for A      
         using 
           ArrVal_eq_helper[
             OF \<NN>.ntcf_Comp_commute[OF assms(4), symmetric], where a=A
             ]
           assms(4)
           that
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
       from \<MM>(1) assms(2,3,4) have \<MM>a_CId_a: 
         "\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> \<in>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by (subst \<MM>)
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
               cs_intro: cat_Set_cs_intros cat_cs_intros
           )
 
       have \<FF>f_\<MM>a_eq_\<MM>b:
         "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>\<rparr> =
           \<MM>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h\<rparr>"
         if "h : a \<mapsto>\<^bsub>\<CC>\<^esub> a" for h
         using 
           ArrVal_eq_helper[
             OF \<MM>.ntcf_Comp_commute[OF assms(4), symmetric], where a=h
             ]
           that
           assms(4)
           category_axioms
         by
           (
             cs_prems
               cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
           )
     
       from \<MM>(1) assms(2,3,4) \<MM>a_CId_a category_axioms show 
         "(ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<GG>) b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?hom)\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<rparr> =
           (
             cf_eval_arrow \<CC> (ntcf_arrow \<NN>) f \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
             ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) a
           )\<lparr>ArrVal\<rparr>\<lparr>\<MM>\<rparr>" 
         by (subst (1 2) \<MM>(2)) (*very slow*)
           (
             cs_concl
               cs_simp:
                 \<FF>f_\<MM>a_eq_\<MM>b \<GG>\<NN>_eq_\<NN>\<FF>
                 cat_FUNCT_cs_simps 
                 cat_cs_simps 
                 cat_op_simps
               cs_intro: 
                 cat_Set_\<alpha>\<beta>.subcat_is_arrD 
                 cat_small_cs_intros
                 cat_cs_intros 
                 cat_FUNCT_cs_intros
                 cat_prod_cs_intros
                 cat_op_intros
           )+
 
     qed (use arr_Set_\<GG>b_\<NN>f arr_Set_\<NN>f_\<FF>a in auto)
 
   qed (use \<GG>b_\<NN>f \<NN>f_\<FF>a in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
 qed
 
 
 
 subsection\<open>Yoneda Lemma: naturality\<close>
 
 
 subsubsection\<open>
 The Yoneda natural transformation: definition and elementary properties
 \<close>
 
 
 text\<open>
 The main result of this subsection corresponds to the corollary to the 
 Yoneda Lemma on page 61 in \cite{mac_lane_categories_2010}.
 \<close>
 
 definition ntcf_Yoneda :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_Yoneda \<alpha> \<beta> \<CC> =
     [
       (
         \<lambda>\<FF>r\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>. 
           ntcf_Yoneda_arrow \<alpha> \<CC> (\<FF>r\<lparr>0\<rparr>) (\<FF>r\<lparr>1\<^sub>\<nat>\<rparr>)
       ),
       cf_nt \<alpha> \<beta> (cf_id \<CC>),
       cf_eval \<alpha> \<beta> \<CC>,
       cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>,
       cat_Set \<beta>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_Yoneda_components:
   shows "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr> =
     (
       \<lambda>\<FF>r\<in>\<^sub>\<circ>(cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>.
         ntcf_Yoneda_arrow \<alpha> \<CC> (\<FF>r\<lparr>0\<rparr>) (\<FF>r\<lparr>1\<^sub>\<nat>\<rparr>)
     )"
     and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDom\<rparr> = cf_nt \<alpha> \<beta> (cf_id \<CC>)"
     and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTCod\<rparr> = cf_eval \<alpha> \<beta> \<CC>"
     and [cat_cs_simps]: 
       "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDGDom\<rparr> = cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>"
     and [cat_cs_simps]: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
   unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)
     
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda ntcf_Yoneda_components(1)
   |vsv ntcf_Yoneda_NTMap_vsv[cat_cs_intros]|
   |vdomain ntcf_Yoneda_NTMap_vdomain[cat_cs_intros]|
 
 lemma (in category) ntcf_Yoneda_NTMap_app[cat_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     and "\<FF>r = [cf_map \<FF>, r]\<^sub>\<circ>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> = ntcf_Yoneda_arrow \<alpha> \<CC> (cf_map \<FF>) r"
 proof-            
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<FF> by (rule assms(4))
   interpret \<beta>\<CC>: category \<beta> \<CC>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   from assms(2) interpret FUNCT: category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
     by
       (
         cs_concl cs_intro: 
           cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
       )
   from assms(5) have "[cf_map \<FF>, r]\<^sub>\<circ> \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
     by
       (
         cs_concl 
           cs_simp: cat_FUNCT_cs_simps
           cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
       )
   then show ?thesis
     unfolding assms(3) ntcf_Yoneda_components by (simp add: nat_omega_simps)
 qed
 
 lemmas [cat_cs_simps] = category.ntcf_Yoneda_NTMap_app
 
 
 subsubsection\<open>The Yoneda natural transformation is a natural transformation\<close>
 
 lemma (in category) cat_ntcf_Yoneda_is_ntcf:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
   shows "ntcf_Yoneda \<alpha> \<beta> \<CC> :
     cf_nt \<alpha> \<beta> (cf_id \<CC>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_eval \<alpha> \<beta> \<CC> :
     cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<beta>\<CC>: category \<beta> \<CC>
     by (rule category.cat_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   from assms(2) interpret FUNCT: category \<beta> \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
     by 
       (
         cs_concl cs_intro: 
           cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
       )
 
   show ?thesis
   proof(intro is_iso_ntcfI is_ntcfI')
     show "vfsequence (ntcf_Yoneda \<alpha> \<beta> \<CC>)" unfolding ntcf_Yoneda_def by simp
     show "vcard (ntcf_Yoneda \<alpha> \<beta> \<CC>) = 5\<^sub>\<nat>"
       unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
     show ntcf_Yoneda_\<FF>r: "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> :
       cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr>"
       if "\<FF>r \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>r
     proof-
       from that obtain \<FF> r 
         where \<FF>r_def: "\<FF>r = [\<FF>, r]\<^sub>\<circ>" 
           and \<FF>: "\<FF> \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> (cat_Set \<alpha>)"
           and r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by
           (
             auto 
               elim: cat_prod_2_ObjE[rotated 2] 
               simp: cat_FUNCT_cs_simps
               intro: cat_cs_intros
            )
       from \<FF> obtain \<GG>
         where \<FF>_def: "\<FF> = cf_map \<GG>" and \<GG>: "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
         by clarsimp
       from assms(2) \<GG> r show ?thesis
         unfolding \<FF>r_def \<FF>_def 
         by
           (
             cs_concl! 
               cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
            )      
     qed
     show "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>r\<rparr> :
       cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> cf_eval \<alpha> \<beta> \<CC>\<lparr>ObjMap\<rparr>\<lparr>\<FF>r\<rparr>"
       if "\<FF>r \<in>\<^sub>\<circ> (cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>" for \<FF>r
       by (rule is_arr_isomorphismD[OF ntcf_Yoneda_\<FF>r[OF that]])
     show 
       "ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<GG>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> 
         cf_nt \<alpha> \<beta> (cf_id \<CC>)\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> =
           cf_eval \<alpha> \<beta> \<CC>\<lparr>ArrMap\<rparr>\<lparr>\<NN>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> 
             ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>\<FF>a\<rparr>"
       if \<NN>f: "\<NN>f : \<FF>a \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>) \<times>\<^sub>C \<CC>\<^esub> \<GG>b" for \<FF>a \<GG>b \<NN>f
     proof-
       obtain \<NN> f \<FF> a \<GG> b
         where \<NN>f_def: "\<NN>f = [\<NN>, f]\<^sub>\<circ>" 
           and \<FF>a_def: "\<FF>a = [\<FF>, a]\<^sub>\<circ>"
           and \<GG>b_def: "\<GG>b = [\<GG>, b]\<^sub>\<circ>" 
           and \<NN>: "\<NN> : \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> \<GG>" 
           and f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
         by 
           (
             auto intro: 
               cat_prod_2_is_arrE[rotated 2, OF \<NN>f] 
               FUNCT.category_axioms 
               \<beta>\<CC>.category_axioms
           )
       note \<NN> = cat_FUNCT_is_arrD[OF \<NN>]
       note [cat_cs_simps] = 
         cat_ntcf_Yoneda_arrow_commutativity[OF assms \<NN>(1) f, folded \<NN>(2,3,4)]
       from \<NN>(1) assms(2) f show ?thesis
         unfolding \<NN>f_def \<FF>a_def \<GG>b_def
         by (subst (1 2) \<NN>(2), use nothing in \<open>subst \<NN>(3), subst \<NN>(4)\<close>)
           (
             cs_concl
               cs_simp: \<NN>(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
           )+
     qed
 
   qed (use assms(2) in \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>)+
 
 qed
 
 
 
 subsection\<open>\<open>Hom\<close>-map\<close>
 
 text\<open>
 This subsection presents some of the results stated as Corollary 2 
 in subsection 1.15 in \cite{bodo_categories_1970} and the corollary 
 following the statement of the Yoneda Lemma on 
 page 61 in \cite{mac_lane_categories_2010} in a variety of forms.
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The following function makes an explicit appearance in subsection 1.15 in 
 \cite{bodo_categories_1970}.
 \<close>
 
 definition ntcf_Hom_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "ntcf_Hom_map \<alpha> \<CC> a b = (\<lambda>f\<in>\<^sub>\<circ>Hom \<CC> a b. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-))"
 
 
 text\<open>Elementary properties.\<close>
 
 mk_VLambda ntcf_Hom_map_def
   |vsv ntcf_Hom_map_vsv|
   |vdomain ntcf_Hom_map_vdomain[cat_cs_simps]|
   |app ntcf_Hom_map_app[unfolded in_Hom_iff, cat_cs_simps]|
 
 
 subsubsection\<open>\<open>Hom\<close>-map is a bijection\<close>
 
 lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
   \<comment>\<open>The following lemma approximately corresponds to the corollary on 
 page 61 in \cite{mac_lane_categories_2010}.\<close>
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
     and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
     and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
       f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
 proof-
 
   interpret \<NN>: is_ntcf \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)\<close> \<NN>
     by (rule assms(3))
   let ?Y_Hom_s = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<close>
   note Yoneda = 
     cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
   interpret Y: v11 \<open>?Y_Hom_s\<close> by (rule Yoneda(1))
 
   from category_axioms assms have \<NN>_in_vdomain: "\<NN> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (?Y_Hom_s)" 
     by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros) 
   then have "?Y_Hom_s\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
   from this category_axioms assms show Ym_\<NN>: "?Y_Hom_s\<lparr>\<NN>\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
     unfolding Yoneda(2) 
     by (cs_prems_step cs_simp: cat_cs_simps cat_op_simps)+ simp
   then have "?Y_Hom_s\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" by (simp add: cat_cs_intros)
 
   have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (intro cat_ntcf_Hom_snd_is_ntcf Ym_\<NN>)
 
   from assms Ym_\<NN> this category_axioms assms have 
     "(?Y_Hom_s)\<inverse>\<^sub>\<circ>\<lparr>?Y_Hom_s\<lparr>\<NN>\<rparr>\<rparr> =
       Yoneda_arrow \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r (?Y_Hom_s\<lparr>\<NN>\<rparr>)"
     by (intro category.inv_Yoneda_map_app)
       (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
   then have "(?Y_Hom_s)\<inverse>\<^sub>\<circ>\<lparr>?Y_Hom_s\<lparr>\<NN>\<rparr>\<rparr> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-)"
     by (simp add: ntcf_Hom_snd_def'[OF Ym_\<NN>])
   with \<NN>_in_vdomain show "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Y_Hom_s\<lparr>\<NN>\<rparr>,-)" by auto
 
   fix f assume prems: "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
   then obtain a b where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto
 
   have "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
   with f \<NN>.ntcf_NTDom \<NN>.ntcf_NTCod assms cat_is_arrD(2,3)[OF f] 
   have ba_simps: "b = r" "a = s"
     by 
       (
         simp_all add: 
           prems(2) cat_cf_Hom_snd_inj cat_ntcf_Hom_snd_components(2,3)
       )
   from f have "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r" unfolding ba_simps .
 
   with category_axioms show "f = ?Y_Hom_s\<lparr>\<NN>\<rparr>"
     unfolding prems(2) by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
 
 qed
 
 lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique:
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr> : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
     and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>)"
     and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) \<rbrakk> \<Longrightarrow>
       f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>"
   by 
     (
       intro  
         category.cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[
           OF category_op, 
           unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
           OF assms(1,2), 
           unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
           OF assms(3)
           ]
     )+
 
 lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique':
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "\<exists>!f. f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
   using cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms] by blast
 
 lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique':
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "\<exists>!f. f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr> \<and> \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)"
   using cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique[OF assms] by blast
 
 lemma (in category) cat_ntcf_Hom_snd_inj:
   assumes "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)" 
     and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
   shows "g = f"
 proof-
   from assms have 
     "Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) b\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-)\<rparr> =
       Yoneda_map \<alpha> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)) b\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr>"
     by simp
   from this assms category_axioms show "g = f"
     by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros) 
       simp (*slow*)
 qed
 
 lemma (in category) cat_ntcf_Hom_fst_inj:
   assumes "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,g) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)" 
     and "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
   shows "g = f"
 proof-
   from category.cat_ntcf_Hom_snd_inj
     [
       OF category_op, 
       unfolded cat_op_simps,
       unfolded cat_op_cat_ntcf_Hom_snd,
       OF assms
     ]
   show ?thesis .
 qed
 
 lemma (in category) cat_ntcf_Hom_map: 
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "v11 (ntcf_Hom_map \<alpha> \<CC> a b)" 
     and "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) =
       these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
     and "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ> =
       (\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
         Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>)"
 proof-
 
   show "v11 (ntcf_Hom_map \<alpha> \<CC> a b)"
   proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
     show "vsv (ntcf_Hom_map \<alpha> \<CC> a b)" unfolding ntcf_Hom_map_def by simp
     fix g f assume prems: 
       "g : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
       "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
       "ntcf_Hom_map \<alpha> \<CC> a b\<lparr>g\<rparr> = ntcf_Hom_map \<alpha> \<CC> a b\<lparr>f\<rparr>"
     from prems(3,1,2) have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
       by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     with prems(1,2) show "g = f" by (intro cat_ntcf_Hom_snd_inj[of g f])
   qed
   then interpret Hm: v11 \<open>ntcf_Hom_map \<alpha> \<CC> a b\<close> .
 
   show Hm_vrange: "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) =
     these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
   proof(intro vsubset_antisym)
     show "\<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b) \<subseteq>\<^sub>\<circ>
       these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
       by 
         (
           unfold ntcf_Hom_map_def,
           intro vrange_VLambda_vsubset, 
           unfold these_ntcfs_iff in_Hom_iff, 
           intro cat_ntcf_Hom_snd_is_ntcf
         )
     show "these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<subseteq>\<^sub>\<circ>
       \<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b)"
     proof(intro vsubsetI, unfold these_ntcfs_iff)
       fix \<NN> assume prems: 
         "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       note unique = 
         cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
       from unique(1) have 
         "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b)"
         by (cs_concl cs_simp: cat_cs_simps)
       moreover from 
         cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF assms(2,1) prems] 
       have \<NN>_def: "\<NN> = ntcf_Hom_map \<alpha> \<CC> a b\<lparr>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps)
       ultimately show "\<NN> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (ntcf_Hom_map \<alpha> \<CC> a b)" by force
     qed 
   qed
 
   show "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ> =
     (
       \<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
         Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
     )"
   proof
     (
       rule vsv_eqI, 
       unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
     )
 
     from Hm.v11_axioms show "vsv ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>)" by auto
     show "vsv 
       (
         \<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
           Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
       )"
       by simp
 
     fix \<NN> assume prems: 
       "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     then have \<NN>: 
       "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
       unfolding these_ntcfs_iff by simp
     show "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> =
       (
         \<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-).
           Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>
       )\<lparr>\<NN>\<rparr>"
     proof
       (
         intro Hm.v11_vconverse_app, 
         unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF \<NN>]
       )
       note unique = 
         cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
       show "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr> : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by (rule unique(1))
       then show 
         "ntcf_Hom_map \<alpha> \<CC> a b\<lparr>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>\<rparr> = \<NN>"
         by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
     qed
 
   qed simp
 
 qed
 
 
 subsubsection\<open>Inverse of a \<open>Hom\<close>-map\<close>
 
 lemma (in category) inv_ntcf_Hom_map_v11: 
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "v11 ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>)"
   using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)
 
 lemma (in category) inv_ntcf_Hom_map_vdomain: 
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>) =
     these_ntcfs \<alpha> \<CC> (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-)"
   unfolding cat_ntcf_Hom_map(3)[OF assms] by simp
 
 lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_vdomain
 
 lemma (in category) inv_ntcf_Hom_map_app: 
   assumes "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "(ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) b\<lparr>\<NN>\<rparr>"
   using assms(3) unfolding cat_ntcf_Hom_map(3)[OF assms(1,2)] by simp
 
 lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_app
 
 lemma inv_ntcf_Hom_map_vrange: "\<R>\<^sub>\<circ> ((ntcf_Hom_map \<alpha> \<CC> a b)\<inverse>\<^sub>\<circ>) = Hom \<CC> a b"
   unfolding ntcf_Hom_map_def by simp
 
 
 subsubsection\<open>\<open>Hom\<close>-natural transformation and isomorphisms\<close>
 
 
 text\<open>
 This subsection presents further results that were stated 
 as Corollary 2 in subsection 1.15 in \cite{bodo_categories_1970}.
 \<close>
 
 lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf:
   assumes "f : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   from assms obtain g 
     where iso_g: "g : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s" 
       and gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = \<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>"
       and fg: "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g = \<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
     by 
       (
         auto intro:
           cat_the_inverse_Comp_CId_left 
           cat_the_inverse_Comp_CId_right 
           cat_the_inverse_is_arr_isomorphism'
       )
   then have g: "g : r \<mapsto>\<^bsub>\<CC>\<^esub> s" by auto
   show ?thesis
   proof(intro is_arr_isomorphism_is_iso_ntcf)
     from assms have f: "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
     with category_axioms show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
     from category_axioms g show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)    
     from category_axioms f g have 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f,-)"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     also from category_axioms f g have "\<dots> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
       by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
     finally show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
       by simp
     from category_axioms f g have 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g,-)"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     also from category_axioms f g have "\<dots> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
       by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
     finally show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
       by simp
   qed
 qed
 
 lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_fst_is_iso_ntcf:
   assumes "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   from assms have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   from 
     category.cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf
       [
         OF category_op, 
         unfolded cat_op_simps,
         OF assms,
         unfolded
           category.cat_op_cat_cf_Hom_snd[OF category_axioms r]
           category.cat_op_cat_cf_Hom_snd[OF category_axioms s]
           category.cat_op_cat_ntcf_Hom_snd[OF category_axioms]
       ]
   show ?thesis.
 qed
 
 lemma (in category) cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique:
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
     and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
     and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
       f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
 proof-
 
   let ?Ym_\<NN> = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>\<close>
     and ?Ym_inv_\<NN> = \<open>Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) s\<lparr>inv_ntcf \<NN>\<rparr>\<close>
 
   from assms(3) have \<NN>:
     "\<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by auto
   from iso_ntcf_is_arr_isomorphism[OF assms(3)] 
   have iso_inv_\<NN>: "inv_ntcf \<NN> : 
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and [simp]: "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
     and [simp]: "inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
     by auto
   from iso_inv_\<NN> have inv_\<NN>: 
     "inv_ntcf \<NN> : Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by auto 
   note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) \<NN>]
     and inv_unique = 
     cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_\<NN>]
   have Ym_\<NN>: "?Ym_\<NN> : s \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule unique(1))
 
   show "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>,-)"
     and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<rbrakk> \<Longrightarrow>
       f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr>"
     by (intro unique)+
 
   show "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>\<NN>\<rparr> : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
   proof(intro is_arr_isomorphismI[OF Ym_\<NN>, of \<open>?Ym_inv_\<NN>\<close>] is_inverseI)
 
     show Ym_inv_\<NN>: "?Ym_inv_\<NN> : r \<mapsto>\<^bsub>\<CC>\<^esub> s" by (rule inv_unique(1))
     
     have "ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf \<NN>" by simp
     also have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN>,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN>,-)"
       by (subst unique(2), subst inv_unique(2)) simp
     also from category_axioms Ym_\<NN> inv_unique(1) assms(3) have 
       "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-)"
       by (cs_concl cs_simp: cat_cs_simps)
     finally have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-)"
       by simp
     also from category_axioms assms(1,2) have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>,-)"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     finally have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>,-)"
       by simp
     then show "?Ym_inv_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_\<NN> = \<CC>\<lparr>CId\<rparr>\<lparr>s\<rparr>"
       by (rule cat_ntcf_Hom_snd_inj)
         (
           all\<open>
             use category_axioms Ym_\<NN> Ym_inv_\<NN> assms in 
               \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
             \<close>
         )
     have "ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) = inv_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>" by simp
     also have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_inv_\<NN>,-) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN>,-)"
       by (subst unique(2), subst inv_unique(2)) simp
     also from category_axioms Ym_\<NN> inv_unique(1) have 
       "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-)"
       by (cs_concl cs_simp: cat_cs_simps)
     finally have 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-) = ntcf_id Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-)"
       by simp
     also from category_axioms assms(1,2) have "\<dots> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>,-)"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     finally have 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>,-)"
       by simp
     then show "?Ym_\<NN> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?Ym_inv_\<NN> = \<CC>\<lparr>CId\<rparr>\<lparr>r\<rparr>"
       by (rule cat_ntcf_Hom_snd_inj)
         (
           all\<open>
             use category_axioms Ym_\<NN> Ym_inv_\<NN> assms in 
               \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
             \<close>
         )
 
   qed (intro Ym_\<NN>)
 
 qed
 
 lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
   assumes "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<NN> : 
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr> : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
     and "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>)"
     and "\<And>f. \<lbrakk> f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>; \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) \<rbrakk> \<Longrightarrow>
       f = Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>\<NN>\<rparr>"
   by 
     (
       intro  
         category.cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[
           OF category_op, 
           unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
           OF assms(1,2), 
           unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
           OF assms(3)
           ]
     )+
 
 lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf:
   assumes "f : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(r,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "f : s \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
 proof-
   from assms(1) have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   note unique = cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[OF r s assms(2)]
   from unique(1) have Ym_Hf: 
     "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(s,-) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)\<rparr> : s \<mapsto>\<^bsub>\<CC>\<^esub> r"
     by auto
   from unique(1) show ?thesis
     unfolding cat_ntcf_Hom_snd_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
     by simp
 qed
 
 lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_fst_is_iso_ntcf:
   assumes "f : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,r) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> s"
 proof-
   from assms(1) have r: "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and s: "s \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   note unique = cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique[OF r s assms(2)]
   from unique(1) have Ym_Hf: 
     "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,s) r\<lparr>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(-,f)\<rparr> : r \<mapsto>\<^bsub>\<CC>\<^esub> s"
     by auto
   from unique(1) show ?thesis
     unfolding cat_ntcf_Hom_fst_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
     by simp
 qed
 
 
 subsubsection\<open>
 The relationship between a \<open>Hom\<close>-natural transformation and the compositions 
 of a \<open>Hom\<close>-natural transformation and a natural transformation
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<lparr>NTMap\<rparr>\<lparr>b, c\<rparr>\<^sub>\<bullet> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
 proof-      
   interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from assms(2) have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
   from category_axioms assms(1,3) b show ?thesis
     by 
       (
         cs_concl 
           cs_simp: 
             cat_ntcf_lcomp_Hom_component_is_Yoneda_component cat_cs_simps 
           cs_intro: cat_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
 
 lemma (in category) cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))  
   show ?thesis
   proof(rule ntcf_eqI[of \<alpha>])
     from category_axioms assms show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : 
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) : 
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"      
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
     from assms this have dom_lhs:
       "\<D>\<^sub>\<circ> ((Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from category_axioms assms show 
       "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
         \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms this have dom_rhs: 
       "\<D>\<^sub>\<circ> (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show 
       "(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr> = 
         Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       with category_axioms assms show
         "(Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
           Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps) 
     qed (use assms(2) in \<open>auto intro: cat_cs_intros\<close>)
   qed simp_all
 qed
 
 lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd
 
 
 subsubsection\<open>
 The relationship between the \<open>Hom\<close>-natural isomorphisms and the compositions
 of a \<open>Hom\<close>-natural isomorphism and a natural transformation
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>b. b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr> \<Longrightarrow> Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
     op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F : 
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o 
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>C\<^sub>F : 
     \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     unfolding 
       cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1) that]
       cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.NTDom.is_functor_axioms that]
       cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.NTCod.is_functor_axioms that]
     by (intro assms(2) that)
   from 
     is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
       OF 
         \<phi>.NTDom.HomDom.category_op category_axioms 
         cat_ntcf_lcomp_Hom_is_ntcf[OF assms(1)], 
       unfolded cat_op_simps, OF this
       ]
   show ?thesis .
 qed
 
 lemma (in category) cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
     \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   from category_axioms assms show ?thesis
     by  
       (
         fold 
           cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1,3)]
           cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.NTDom.is_functor_axioms assms(3)]
           cat_cf_lcomp_Hom_cf_Hom_snd[OF \<phi>.NTCod.is_functor_axioms assms(3)],
         intro bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf
       )    
       (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
 qed
 
 
 
 subsection\<open>Yoneda map for arbitrary functors\<close>
 
 
 text\<open>
 The concept of the Yoneda map for arbitrary functors was developed based
 on the function that was used in the statement of Lemma 3 in 
 subsection 1.15 in \cite{bodo_categories_1970}.
 \<close>
 
 definition af_Yoneda_map :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "af_Yoneda_map \<alpha> \<FF> \<GG> =
     (\<lambda>\<phi>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>) \<FF> \<GG>. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-))"
 
 
 text\<open>Elementary properties.\<close>
 
 context
   fixes \<alpha> \<BB> \<CC> \<FF> \<GG>
   assumes \<FF>: "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<GG>: "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule \<FF>)
 interpretation \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule \<GG>)
 
 mk_VLambda 
   af_Yoneda_map_def[where \<FF>=\<FF> and \<GG>=\<GG>, unfolded \<FF>.cf_HomDom \<FF>.cf_HomCod]
   |vsv af_Yoneda_map_vsv|
   |vdomain af_Yoneda_map_vdomain[cat_cs_simps]|
   |app af_Yoneda_map_app[unfolded these_ntcfs_iff, cat_cs_simps]|
 
 end
 
 
 
 subsection\<open>Yoneda arrow for arbitrary functors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The following natural transformation is used in the proof of Lemma 3 in 
 subsection 1.15 in \cite{bodo_categories_1970}.
 \<close>
 
 definition af_Yoneda_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> =
     [
       (
         \<lambda>b\<in>\<^sub>\<circ>(\<FF>\<lparr>HomDom\<rparr>)\<lparr>Obj\<rparr>.
           Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
             \<NN>\<^bsub>op_cat (\<FF>\<lparr>HomDom\<rparr>),\<FF>\<lparr>HomCod\<rparr>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
             \<rparr>
       ),
       \<FF>,
       \<GG>,
       \<FF>\<lparr>HomDom\<rparr>,
       \<FF>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma af_Yoneda_arrow_components:
   shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr> =
       (
         \<lambda>b\<in>\<^sub>\<circ>\<FF>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
           Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<FF>\<lparr>HomCod\<rparr>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
             \<NN>\<^bsub>op_cat (\<FF>\<lparr>HomDom\<rparr>),\<FF>\<lparr>HomCod\<rparr>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
             \<rparr>
       )"
     and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDom\<rparr> = \<FF>"
     and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTCod\<rparr> = \<GG>"
     and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDGDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
     and "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTDGCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
   unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda af_Yoneda_arrow_components(1)
   |vsv af_Yoneda_arrow_NTMap_vsv|
 
 context
   fixes \<alpha> \<BB> \<CC> \<FF>
   assumes \<FF>: "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule \<FF>)
 
 mk_VLambda 
   af_Yoneda_arrow_components(1)[where \<FF>=\<FF>, unfolded \<FF>.cf_HomDom \<FF>.cf_HomCod]
   |vdomain af_Yoneda_arrow_NTMap_vdomain[cat_cs_simps]|
   |app af_Yoneda_arrow_NTMap_app[cat_cs_simps]|
 
 end
 
 lemma (in category) cat_af_Yoneda_arrow_is_ntcf:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
     and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
     and ?Set = \<open>cat_Set \<alpha>\<close>
     and ?Ym = 
       \<open>
         \<lambda>b. Yoneda_map
           \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<rparr>
       \<close>
 
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   interpret \<NN>: is_ntcf 
     \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close> \<NN> 
     by (rule assms)
 
   have comm[unfolded cat_op_simps]:
-    "(\<NN>\<lparr>NTMap\<rparr> \<lparr>c, d\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<rparr> =
-      f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ((\<NN>\<lparr>NTMap\<rparr> \<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
+    "(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<rparr> =
+      f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
     if "g : a \<mapsto>\<^bsub>op_cat \<BB>\<^esub> c" and "f : b \<mapsto>\<^bsub>\<CC>\<^esub> d" and "q : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b" 
     for q g f a b c d
   proof-
     from that(1) have g: "g : c \<mapsto>\<^bsub>\<BB>\<^esub> a" unfolding cat_op_simps by simp
     from category_axioms assms g that(2) have ab:
       "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
       by 
         (
           cs_concl 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
     from \<NN>.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have \<NN>ab: 
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet> :
         Hom \<CC> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) b"
       by 
         (
           cs_prems 
             cs_simp: cat_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
     have \<NN>_abq: "(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> b"
       by 
         (
           rule cat_Set_ArrVal_app_vrange[
             OF \<NN>ab, unfolded in_Hom_iff, OF that(3)
             ]
         )
     have "[g, f]\<^sub>\<circ> : [a, b]\<^sub>\<circ> \<mapsto>\<^bsub>op_cat \<BB> \<times>\<^sub>C \<CC>\<^esub> [c, d]\<^sub>\<circ>"
       by 
         (
           rule 
             cat_prod_2_is_arrI[
               OF \<FF>.HomDom.category_op category_axioms that(1,2)
               ]
         )
     then have 
       "\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> =
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>"
       by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
     then have 
       "(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>?Set\<^esub> ?H\<GG>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> =
         (?H\<FF>\<lparr>ArrMap\<rparr>\<lparr>g, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>?Set\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr>"
       by auto
 
     from 
       this that(2,3) assms
       category_axioms \<FF>.HomDom.category_axioms \<FF>.HomDom.category_op category_op
       g \<NN>ab \<NN>_abq 
     show
       "(\<NN>\<lparr>NTMap\<rparr>\<lparr>c, d\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (q \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<rparr> =
         f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ((\<NN>\<lparr>NTMap\<rparr>\<lparr>a, b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>q\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)" 
       by 
         (
           cs_prems
             cs_simp: cat_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
   qed
 
   show ?thesis
   proof(rule is_ntcfI')
 
     show "vfsequence (af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>)"
       unfolding af_Yoneda_arrow_def by simp
     show "vcard (af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>) = 5\<^sub>\<nat>"
       unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)
 
     have \<NN>b: "\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
       by 
         (
           rule 
             bnt_proj_snd_is_ntcf
               [
                 OF \<FF>.HomDom.category_op category_axioms assms(3),
                 unfolded cat_op_simps, 
                 OF that,
                 unfolded 
                   cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) that]
                   cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) that]
               ]
         )
 
     show "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     proof-
       let ?\<GG>b = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
         and ?\<FF>b = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
         and ?\<CC>\<GG>b = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close>
       from that have \<CC>\<GG>b: "?\<CC>\<GG>b : ?\<GG>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b" by (auto simp: cat_cs_intros)
       from assms that have "[b, ?\<GG>b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_b\<GG>b: 
         "\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>b ?\<GG>b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>b ?\<GG>b"
         by 
           (
             cs_prems 
               cs_simp: cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
       from \<CC>\<GG>b have \<NN>_b\<GG>b_\<CC>\<GG>b: 
         "(\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> : ?\<FF>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b"
         by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_b\<GG>b, unfolded in_Hom_iff])
       with category_axioms assms that \<NN>b[OF that] show ?thesis
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
     qed
 
     show 
       "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = 
         \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f
     proof-
 
       from that have a: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" by auto
       
       let ?\<BB>a = \<open>\<BB>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<close>
         and ?\<BB>b = \<open>\<BB>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<close>
         and ?\<GG>a = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
         and ?\<GG>b = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
         and ?\<FF>a = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close>
         and ?\<FF>b = \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
         and ?\<CC>\<GG>a = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>\<close>
         and ?\<CC>\<GG>b = \<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close>
 
       from that have \<CC>\<GG>a: "?\<CC>\<GG>a : ?\<GG>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>a" by (auto intro: cat_cs_intros)
       from that have \<CC>\<GG>b: "?\<CC>\<GG>b : ?\<GG>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b" by (auto intro: cat_cs_intros)
       from that have \<BB>a: "?\<BB>a : a \<mapsto>\<^bsub>\<BB>\<^esub> a" by (auto intro: cat_cs_intros)
 
       from assms that have "[b, ?\<GG>b]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_b\<GG>b: 
         "\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>b ?\<GG>b \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>b ?\<GG>b"
         by 
           (
             cs_prems 
               cs_simp: cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
       from \<CC>\<GG>b have \<NN>_b\<GG>b_\<CC>\<GG>b: 
         "(\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> : ?\<FF>b \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>b"
         by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_b\<GG>b, unfolded in_Hom_iff])
 
       from assms that have "[a, ?\<GG>a]\<^sub>\<circ> \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
           )
       from \<NN>.ntcf_NTMap_is_arr[OF this] category_axioms assms that have \<NN>_a\<GG>a: 
         "\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet> : Hom \<CC> ?\<GG>a ?\<GG>a \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<CC> ?\<FF>a ?\<GG>a"
         by 
           (
             cs_prems 
               cs_simp: cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_prod_cs_intros
           )
       from \<CC>\<GG>a have \<NN>_a\<GG>a_\<CC>\<GG>a: 
         "(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>a\<rparr> : ?\<FF>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<GG>a"
         by (rule cat_Set_ArrVal_app_vrange[OF \<NN>_a\<GG>a, unfolded in_Hom_iff])
 
       from 
         comm[OF \<BB>a \<GG>.cf_ArrMap_is_arr[OF that] \<CC>\<GG>a] 
         category_axioms assms that \<NN>_a\<GG>a_\<CC>\<GG>a
       have \<NN>_a_\<GG>b[symmetric, cat_cs_simps]:
         "(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> =
           \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>a\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>a\<rparr>"
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
       from comm[OF that \<CC>\<GG>b \<CC>\<GG>b] category_axioms assms that \<NN>_b\<GG>b_\<CC>\<GG>b
       have \<NN>_a_\<GG>b'[cat_cs_simps]:
         "(\<NN>\<lparr>NTMap\<rparr>\<lparr>a, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>\<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> =
           (\<NN>\<lparr>NTMap\<rparr>\<lparr>b, ?\<GG>b\<rparr>\<^sub>\<bullet>)\<lparr>ArrVal\<rparr>\<lparr>?\<CC>\<GG>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
       from category_axioms assms that \<NN>b[OF a] \<NN>b[OF b] show ?thesis
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
 
     qed
 
   qed (auto simp: af_Yoneda_arrow_components cat_cs_simps intro: cat_cs_intros)
 
 qed
 
 lemma (in category) cat_af_Yoneda_arrow_is_ntcf':
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "\<beta> = \<alpha>"
     and "\<FF>' = \<FF>"
     and "\<GG>' = \<GG>"
   shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<CC>"
   using assms(1-3) unfolding assms(4-6) by (rule cat_af_Yoneda_arrow_is_ntcf)
 
 lemmas [cat_cs_intros] = category.cat_af_Yoneda_arrow_is_ntcf'
 
 
 subsubsection\<open>Yoneda Lemma for arbitrary functors\<close>
 
 
 text\<open>
 The following lemmas correspond to variants of the elements of Lemma 3 
 in subsection 1.15 in \cite{bodo_categories_1970}.
 \<close>
 
 lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>-,-)"
 proof-
 
   let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
     and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
     and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
 
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
 
   interpret \<NN>: is_ntcf \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>?H\<GG>\<close> \<open>?H\<FF>\<close> \<NN>
     by (rule assms(3))
   interpret aY\<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<open>?aYa \<NN>\<close>
     by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
   interpret HY\<NN>: is_ntcf 
     \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>?H\<GG>\<close> \<open>?H\<FF>\<close> \<open>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)\<close>
     by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aY\<NN>.is_ntcf_axioms])
   
   show [cat_cs_simps]: "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)"
   proof 
     (
       rule sym,
       rule ntcf_eqI[OF HY\<NN>.is_ntcf_axioms assms(3)], 
       rule vsv_eqI;
       (intro HY\<NN>.NTMap.vsv_axioms \<NN>.NTMap.vsv_axioms)?;
       (unfold \<NN>.ntcf_NTMap_vdomain HY\<NN>.ntcf_NTMap_vdomain)?
     )
     fix bc assume prems': "bc \<in>\<^sub>\<circ> (op_cat \<BB> \<times>\<^sub>C \<CC>)\<lparr>Obj\<rparr>"
     then obtain b c
       where bc_def: "bc = [b, c]\<^sub>\<circ>" 
         and op_b: "b \<in>\<^sub>\<circ> op_cat \<BB>\<lparr>Obj\<rparr>" 
         and c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       by (auto intro: cat_prod_2_ObjE cat_cs_intros)
     from op_b have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" unfolding cat_op_simps by simp
 
     then have \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       by (auto intro: cat_cs_intros)
     have Ym_\<NN>:
       "Yoneda_map \<alpha> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) (\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)\<lparr>
         \<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F
         \<rparr> = ?aYa \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
       unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp
     
     from 
       bnt_proj_snd_is_ntcf
         [
           OF \<FF>.HomDom.category_op category_axioms assms(3) op_b,
           unfolded 
             cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) b]
             cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) b]
         ]
     have \<NN>b: "\<NN>\<^bsub>op_cat \<BB>,\<CC>\<^esub>(b,-)\<^sub>N\<^sub>T\<^sub>C\<^sub>F :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by simp
     from c show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa \<NN>-,-)\<lparr>NTMap\<rparr>\<lparr>bc\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>bc\<rparr>"
       unfolding 
         bc_def 
         cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aY\<NN>.is_ntcf_axioms b c]
         cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
           OF \<GG>b \<FF>b \<NN>b, unfolded Ym_\<NN>, symmetric
           ]
       by (cs_concl cs_simp: cat_cs_simps)
 
   qed simp_all
 
 qed
 
 lemma (in category) cat_af_Yoneda_Lemma:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "v11 (af_Yoneda_map \<alpha> \<FF> \<GG>)"
     and "\<R>\<^sub>\<circ> (af_Yoneda_map \<alpha> \<FF> \<GG>) =
     these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
     and "(af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ> =
       (
         \<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs
           \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-).
           af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>
       )"
 proof-
 
   let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
     and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
     and ?aYm = \<open>af_Yoneda_map \<alpha> \<FF> \<GG>\<close>
     and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
 
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
 
   show v11_aY: "v11 ?aYm"
   proof
     (
       intro vsv.vsv_valeq_v11I,
       unfold af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
     )
     
     show "vsv (af_Yoneda_map \<alpha> \<FF> \<GG>)" by (rule af_Yoneda_map_vsv[OF assms])
 
     fix \<phi> \<psi> assume prems:
       "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       "\<psi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
       "?aYm\<lparr>\<phi>\<rparr> = ?aYm\<lparr>\<psi>\<rparr>"
 
     interpret \<phi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule prems(1))
     interpret \<psi>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<psi> by (rule prems(2))
 
     from prems(3) have H\<phi>_H\<psi>: "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<psi>-,-)"
       unfolding 
         af_Yoneda_map_app[OF assms prems(1)]
         af_Yoneda_map_app[OF assms prems(2)]
       by simp
 
     show "\<phi> = \<psi>"
     proof
       (
         rule ntcf_eqI[OF prems(1,2)], 
         rule vsv_eqI, 
         unfold \<phi>.ntcf_NTMap_vdomain \<psi>.ntcf_NTMap_vdomain
       )
       fix b assume prems': "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       from prems' have \<phi>b: "\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
         and \<psi>b: "\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
         and \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
         and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by (auto intro: cat_cs_intros cat_prod_cs_intros)
       have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)"
       proof
         (
           rule 
             ntcf_eqI
               [
                 OF 
                   cat_ntcf_Hom_snd_is_ntcf[OF \<phi>b] 
                   cat_ntcf_Hom_snd_is_ntcf[OF \<psi>b]
               ]
         )
         show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>"
         proof
           (
             rule vsv_eqI, 
             unfold 
               ntcf_Hom_snd_NTMap_vdomain[OF \<phi>b]
               ntcf_Hom_snd_NTMap_vdomain[OF \<psi>b]
           )
           fix c assume prems'': "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
           note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
           show 
             "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
               Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-)\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
             unfolding 
               H[OF prems(1) prems' prems'', symmetric]
               H[OF prems(2) prems' prems'', symmetric]
               H\<phi>_H\<psi>
             by simp
         qed 
           (
             simp_all add: 
               ntcf_Hom_snd_NTMap_vsv[OF \<psi>b] ntcf_Hom_snd_NTMap_vsv[OF \<phi>b]
           )
       qed simp_all
       with \<phi>b \<psi>b show "\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
         by (auto intro: cat_ntcf_Hom_snd_inj)
     qed auto
 
   qed
 
   interpret aYm: v11 ?aYm by (rule v11_aY)
 
   have [cat_cs_simps]: "?aYm\<lparr>?aYa \<NN>\<rparr> = \<NN>"
     if "\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" for \<NN>
     using category_axioms assms that 
     by 
       (
         cs_concl 
           cs_simp: 
             cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric] cat_cs_simps
           cs_intro: cat_cs_intros
       )
 
   show aYm_vrange: 
     "\<R>\<^sub>\<circ> ?aYm = these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>"
   proof(intro vsubset_antisym)
     
     show "\<R>\<^sub>\<circ> ?aYm \<subseteq>\<^sub>\<circ> these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>"
     proof
       (
         rule vsv.vsv_vrange_vsubset, 
         unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
       )
       fix \<phi> assume "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       with category_axioms assms show 
         "?aYm\<lparr>\<phi>\<rparr> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed (auto intro: af_Yoneda_map_vsv)
 
     show "these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF> \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> ?aYm"
     proof(rule vsubsetI, unfold these_ntcfs_iff)
       fix \<NN> assume prems: 
         "\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       interpret aY\<NN>: is_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<open>?aYa \<NN>\<close>
         by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
       from prems have \<NN>_def: "\<NN> = ?aYm\<lparr>?aYa \<NN>\<rparr>" 
         by (cs_concl cs_simp: cat_cs_simps)
       from assms aY\<NN>.is_ntcf_axioms have "?aYa \<NN> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ?aYm"
         by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps)
       then show "\<NN> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> ?aYm" by (subst \<NN>_def, intro aYm.vsv_vimageI2) auto
     qed
 
   qed
 
   show "?aYm\<inverse>\<^sub>\<circ> =
     (\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>. ?aYa \<NN>)"
   proof
     (
       rule vsv_eqI, 
       unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
     )
     from aYm.v11_axioms show "vsv ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>)" by auto
     fix \<NN> assume prems: "\<NN> : ?H\<GG> \<mapsto>\<^sub>C\<^sub>F ?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     then have \<NN>: "\<NN> \<in>\<^sub>\<circ> these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>" 
       by simp
     show "?aYm\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> =
       (\<lambda>\<NN>\<in>\<^sub>\<circ>these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) ?H\<GG> ?H\<FF>. ?aYa \<NN>)\<lparr>\<NN>\<rparr>"
     proof
       (
         intro aYm.v11_vconverse_app, 
         unfold beta[OF \<NN>] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
       )
       from prems show \<NN>_def: "?aYm\<lparr>?aYa \<NN>\<rparr> = \<NN>" 
         by (cs_concl cs_simp: cat_cs_simps)
       show "?aYa \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
     qed
   qed simp_all
 
 qed
 
 
 subsubsection\<open>Inverse of the Yoneda map for arbitrary functors\<close>
 
 lemma (in category) inv_af_Yoneda_map_v11: 
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "v11 ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>)"
   using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
 
 lemma (in category) inv_af_Yoneda_map_vdomain: 
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<D>\<^sub>\<circ> ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>) =
     these_ntcfs \<alpha> (op_cat \<BB> \<times>\<^sub>C \<CC>) (cat_Set \<alpha>) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
   unfolding cat_af_Yoneda_Lemma(3)[OF assms] by simp
 
 lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_vdomain
 
 lemma (in category) inv_af_Yoneda_map_app: 
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F  Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "(af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>\<lparr>\<NN>\<rparr> = af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>"
   using assms(3) unfolding cat_af_Yoneda_Lemma(3)[OF assms(1,2)] by simp
 
 lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_app
 
 lemma (in category) inv_af_Yoneda_map_vrange: 
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<R>\<^sub>\<circ> ((af_Yoneda_map \<alpha> \<FF> \<GG>)\<inverse>\<^sub>\<circ>) = these_ntcfs \<alpha> \<BB> \<CC> \<FF> \<GG>"
 proof-
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   from assms show ?thesis 
     unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
 qed
 
 
 subsubsection\<open>Yoneda map for arbitrary functors and natural isomorphisms\<close>
 
 
 text\<open>
 The following lemmas correspond to variants of the elements of
 Lemma 3 in subsection 1.15 in \cite{bodo_categories_1970}.
 \<close>
 
 lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
     op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
 proof-
   interpret \<phi>: is_iso_ntcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<phi> by (rule assms(1))
   show ?thesis
   proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
     fix b assume "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     then show "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<phi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by 
         (
           auto intro!: 
             cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
         )
   qed (auto simp: cat_cs_intros)
 qed
 
 lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf':
   assumes "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<beta> = \<alpha>"
     and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
     and "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)"
     and "\<BB>' = op_cat \<BB> \<times>\<^sub>C \<CC>"
     and "\<CC>' = cat_Set \<alpha>"
   shows "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(\<phi>-,-) : \<GG>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF>' : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> \<CC>'"
   using assms(1)
   unfolding assms(2-6) 
   by (rule cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf)
 
 lemmas [cat_cs_intros] = 
   category.cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf'
 
 lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   
   let ?aYa = \<open>af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
   
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   interpret \<NN>: is_iso_ntcf 
     \<alpha> \<open>op_cat \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close> \<NN>
     by (rule assms(3))
 
   from assms(1,2) \<NN>.is_ntcf_axioms have \<NN>_def: "\<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa-,-)" 
     by (cs_concl cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric])
 
   from category_axioms assms have aYa: "?aYa : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_cs_intros)
   have Hom_aYa: "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>(?aYa-,-) :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
     op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (auto intro: assms(3) simp add: \<NN>_def[symmetric])
   have Hb:
     "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(?aYa\<lparr>NTMap\<rparr>\<lparr>b\<rparr>,-) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>,-) :
       \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     by 
       ( 
         rule cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf[
           OF aYa Hom_aYa that
           ]
       )
 
   show ?thesis
   proof(intro is_iso_ntcfI)
     from category_axioms assms show 
       "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     then have \<GG>b: "\<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<FF>b: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       by (auto intro: cat_cs_intros)
     from assms(1,2) aYa prems have aYa_b: 
       "?aYa\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
     show "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by 
         (
           rule cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf[
             OF aYa_b Hb[OF prems]
             ]
         )
   qed
 
 qed
 
 lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf':
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<NN> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) :
       op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "\<beta> = \<alpha>"
     and "\<FF>' = \<FF>"
     and "\<GG>' = \<GG>"
   shows "af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN> : \<FF>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG>' : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms(1-3) 
   unfolding assms(4-6) 
   by (rule cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf)
 
 lemmas [cat_cs_intros] = 
   category.cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf'
 
 lemma (in category) cat_iso_functor_if_cf_lcomp_Hom_iso_functor:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
   shows "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
 proof-
   let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
     and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
     and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   from assms(3) obtain \<NN> \<AA> \<DD> where \<NN>: "\<NN> : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o ?H\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     by auto
   interpret \<NN>: is_iso_ntcf \<alpha> \<AA> \<DD> ?H\<FF> ?H\<GG> \<NN> by (rule \<NN>)
   from category_axioms assms have "?H\<FF> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   then have \<AA>_def: "\<AA> = op_cat \<BB> \<times>\<^sub>C \<CC>" and \<DD>_def: "\<DD> = cat_Set \<alpha>"
     by (force simp: cat_cs_simps)+
   note \<NN> = \<NN>[unfolded \<AA>_def \<DD>_def]
   from \<NN> have "\<NN> : ?H\<FF> \<mapsto>\<^sub>C\<^sub>F ?H\<GG> : op_cat \<BB> \<times>\<^sub>C \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
   from category_axioms assms \<NN> have 
     "af_Yoneda_arrow \<alpha> \<GG> \<FF> \<NN> : \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   then have "\<GG> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<FF>" by (clarsimp intro!: iso_functorI)
   then show ?thesis by (rule iso_functor_sym)
 qed
 
 lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor:
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
   shows "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)"
 proof-
   let ?H\<GG> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<GG>-,-)\<close>
     and ?H\<FF> = \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-)\<close>
     and ?aYa = \<open>\<lambda>\<NN>. af_Yoneda_arrow \<alpha> \<FF> \<GG> \<NN>\<close>
   interpret \<FF>: is_functor \<alpha> \<BB> \<CC> \<FF> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2))
   from assms obtain \<BB>' \<CC>' \<phi> where \<phi>: "\<phi> : \<FF> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o \<GG> : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
     by auto
   interpret \<phi>: is_iso_ntcf \<alpha> \<BB>' \<CC>' \<FF> \<GG> \<phi> by (rule \<phi>)
   from assms \<phi>.NTDom.is_functor_axioms 
   have \<BB>'_def: "\<BB>' = \<BB>" and \<CC>'_def: "\<CC>' = \<CC>" 
     by fast+
   note \<phi> = \<phi>[unfolded \<BB>'_def \<CC>'_def]
   show ?thesis
     by (rule iso_functor_sym) 
       (
         intro iso_functorI[
           OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF \<phi>]
           ]
       )
 qed
 
 lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
   assumes "\<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<FF> \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> \<GG>"
     and "\<alpha>' = \<alpha>"
     and "\<CC>' = \<CC>"
   shows "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(\<FF>-,-) \<approx>\<^sub>C\<^sub>F\<^bsub>\<alpha>\<^esub> Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>'\<^esub>\<CC>'(\<GG>-,-)"
   using assms(1-3) 
   unfolding assms(4,5) 
   by (rule cat_cf_lcomp_Hom_iso_functor_if_iso_functor)
 
 lemmas [cat_cs_intros] = 
   category.cat_cf_lcomp_Hom_iso_functor_if_iso_functor'
 
 
 
 subsection\<open>The Yoneda Functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-2 in \cite{mac_lane_categories_2010}.\<close>
 
 
 definition Yoneda_functor :: "V \<Rightarrow> V \<Rightarrow> V"
   where "Yoneda_functor \<alpha> \<DD> =
     [
       (\<lambda>r\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(r,-))),
       (\<lambda>f\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Arr\<rparr>. ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(f,-))),
       op_cat \<DD>,
       cat_FUNCT \<alpha> \<DD> (cat_Set \<alpha>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma Yoneda_functor_components: 
   shows "Yoneda_functor \<alpha> \<DD>\<lparr>ObjMap\<rparr> =
       (\<lambda>r\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Obj\<rparr>. cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(r,-)))"
     and "Yoneda_functor \<alpha> \<DD>\<lparr>ArrMap\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>op_cat \<DD>\<lparr>Arr\<rparr>. ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<DD>(f,-)))"
     and "Yoneda_functor \<alpha> \<DD>\<lparr>HomDom\<rparr> = op_cat \<DD>"
     and "Yoneda_functor \<alpha> \<DD>\<lparr>HomCod\<rparr> = cat_FUNCT \<alpha> \<DD> (cat_Set \<alpha>)"
   unfolding Yoneda_functor_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda Yoneda_functor_components(1)
   |vsv Yoneda_functor_ObjMap_vsv[cat_cs_intros]|
   |vdomain Yoneda_functor_ObjMap_vdomain[cat_cs_simps]|
   |app Yoneda_functor_ObjMap_app[cat_cs_simps]|
 
 lemma (in category) Yoneda_functor_ObjMap_vrange:
   "\<R>\<^sub>\<circ> (Yoneda_functor \<alpha> \<CC>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Obj\<rparr>"
 proof
   (
     unfold Yoneda_functor_components, 
     rule vrange_VLambda_vsubset, 
     unfold cat_op_simps
   )
   fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   with category_axioms show 
     "cf_map Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Obj\<rparr>" 
     unfolding cat_op_simps cat_FUNCT_components
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda Yoneda_functor_components(2)
   |vsv Yoneda_functor_ArrMap_vsv[cat_cs_intros]|
   |vdomain Yoneda_functor_ArrMap_vdomain[cat_cs_simps]|
   |app Yoneda_functor_ArrMap_app[cat_cs_simps]|
 
 lemma (in category) Yoneda_functor_ArrMap_vrange:
   "\<R>\<^sub>\<circ> (Yoneda_functor \<alpha> \<CC>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Arr\<rparr>"
 proof
   (
     unfold Yoneda_functor_components, 
     rule vrange_VLambda_vsubset, 
     unfold cat_op_simps
   )
   fix f assume "f \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   then obtain a b where f: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" by auto
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<Z>\<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<Z>_\<alpha>_\<alpha>\<omega> \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<beta>_def)
   from tiny_category_cat_FUNCT category_axioms \<Z>\<beta> \<alpha>\<beta> f show
     "ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<lparr>Arr\<rparr>" 
     unfolding cat_op_simps
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
 qed
 
 
 subsubsection\<open>The Yoneda Functor is a fully faithful functor\<close>
 
 lemma (in category) cat_Yoneda_functor_is_functor:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "Yoneda_functor \<alpha> \<CC> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)"
 proof
   (
     intro 
       is_ff_functorI 
       is_ft_functorI' 
       is_fl_functorI' 
       vsubset_antisym 
       vsubsetI,
     unfold cat_op_simps in_Hom_iff, 
     tactic\<open>distinct_subgoals_tac\<close>
   )
 
   interpret Set: category \<alpha> \<open>cat_Set \<alpha>\<close> by (rule category_cat_Set)
 
   let ?Yf = \<open>Yoneda_functor \<alpha> \<CC>\<close> and ?FUNCT = \<open>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<close>
 
   show Yf: "?Yf : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> ?FUNCT"
   proof(intro is_functorI')
     show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
     from assms have "category \<beta> \<CC>" by (intro cat_category_if_ge_Limit)
     then show "category \<beta> (op_cat \<CC>)" by (intro category.category_op)
     from assms show "category \<beta> ?FUNCT" 
       by (cs_concl cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT)
     show "vcard ?Yf = 4\<^sub>\<nat>"
       unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
     show "\<R>\<^sub>\<circ> (?Yf\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> ?FUNCT\<lparr>Obj\<rparr>" 
       by (rule Yoneda_functor_ObjMap_vrange)
     show "?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>op_cat \<CC>\<^esub> b" for a b f
       using that category_axioms
       unfolding cat_op_simps
       by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
     show "?Yf\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f\<rparr> = 
       ?Yf\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>?FUNCT\<^esub> ?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "g : b \<mapsto>\<^bsub>op_cat \<CC>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<CC>\<^esub> b" for b c g a f
       using that category_axioms
       unfolding cat_op_simps
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     show "?Yf\<lparr>ArrMap\<rparr>\<lparr>op_cat \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = ?FUNCT\<lparr>CId\<rparr>\<lparr>?Yf\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       if "c \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>" for c 
       using that category_axioms
       unfolding cat_op_simps
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
   qed (auto simp: assms(1) Yoneda_functor_components \<Z>.intro \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega>)
 
   interpret Yf: is_functor \<beta> \<open>op_cat \<CC>\<close> \<open>?FUNCT\<close> \<open>?Yf\<close> by (rule Yf)
 
   show "v11 (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)"
     if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a b
   proof-
     from that have dom_Y_ba: "\<D>\<^sub>\<circ> (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a) = Hom \<CC> b a"
       by 
         (
           fastforce simp: 
             cat_op_simps 
             in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
         )
 
     show "v11 (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)"
     proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
       fix g f assume prems:
         "g : b \<mapsto>\<^bsub>\<CC>\<^esub> a" 
         "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a" 
         "(?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)\<lparr>g\<rparr> = (?Yf\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<CC> b a)\<lparr>f\<rparr>"
       from 
         prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of \<alpha> \<CC>] 
       have "Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(g,-) = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
         by 
           (
             cs_prems
               cs_simp: V_cs_simps cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
               cs_intro: cat_cs_intros
           )
       from this prems(1,2) show "g = f" by (rule cat_ntcf_Hom_snd_inj)
     qed (auto simp: Yoneda_functor_components)
   qed
 
   fix a b assume prems: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   show "\<NN> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     if "\<NN> \<in>\<^sub>\<circ> ?Yf\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a" for \<NN>
   proof-
     from that obtain f where "?Yf\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<NN>" and f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a"
       by (force elim!: Yf.ArrMap.vsv_vimageE)
     then have \<NN>_def: "\<NN> = ntcf_arrow Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
       unfolding 
         Yoneda_functor_ArrMap_app[
           unfolded cat_op_simps, OF cat_is_arrD(1)[OF f]
           ]
       by (simp add: cat_cs_simps cat_op_simps cat_cs_intros)
     from category_axioms f show ?thesis
       unfolding \<NN>_def
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
         )
   qed
   show "\<NN> \<in>\<^sub>\<circ> ?Yf\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a"
     if "\<NN> : ?Yf\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> (cat_Set \<alpha>)\<^esub> ?Yf\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" for \<NN>
   proof-
     note \<NN> = cat_FUNCT_is_arrD[OF that]
     from \<NN>(1) category_axioms prems have ntcf_\<NN>:
       "ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<NN> : 
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(a,-) \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(b,-) : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (subst (asm) \<NN>(3), use nothing in \<open>subst (asm) \<NN>(4)\<close>)
         (
           cs_prems 
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
         )
     from cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF prems ntcf_\<NN>] obtain f 
       where f: "f : b \<mapsto>\<^bsub>\<CC>\<^esub> a" 
         and \<NN>_def: "ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<NN> = Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(f,-)"
       by auto
     from \<NN>(2) f show "\<NN> \<in>\<^sub>\<circ> Yoneda_functor \<alpha> \<CC>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<CC> b a"
       unfolding \<NN>_def
       by (intro Yf.ArrMap.vsv_vimage_eqI[of f]) 
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
   qed
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy b/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
--- a/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
+++ b/thys/CZH_Foundations/czh_digraphs/CZH_DG_DGHM.thy
@@ -1,1814 +1,1844 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Homomorphism of digraphs\<close>
 theory CZH_DG_DGHM
   imports CZH_DG_Digraph
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems dghm_cs_simps
 named_theorems dghm_cs_intros
 
 named_theorems dg_cn_cs_simps
 named_theorems dg_cn_cs_intros
 
 named_theorems dghm_field_simps
 
 definition ObjMap :: V where [dghm_field_simps]: "ObjMap = 0"
 definition ArrMap :: V where [dghm_field_simps]: "ArrMap = 1\<^sub>\<nat>"
 definition HomDom :: V where [dghm_field_simps]: "HomDom = 2\<^sub>\<nat>"
 definition HomCod :: V where [dghm_field_simps]: "HomCod = 3\<^sub>\<nat>"
 
 
 
 subsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 A homomorphism of digraphs, as presented in this work, can be seen as a
 generalization of the concept of a functor between categories, as presented in
 Chapter I-3 in \cite{mac_lane_categories_2010}, to digraphs. 
 The generalization is performed by removing the axioms (1) from the definition.
 It is expected that the resulting definition is consistent with the conventional
 notion of a homomorphism of digraphs in graph theory, but further details 
 are considered to be outside of the scope of this work.
 
 The definition of a digraph homomorphism is parameterized by a limit ordinal
 \<open>\<alpha>\<close> such that \<open>\<omega> < \<alpha>\<close>. Such digraph homomorphisms are referred to either as
 \<open>\<alpha>\<close>-digraph homomorphisms or homomorphisms of \<open>\<alpha>\<close>-digraphs.
 
 Following \cite{mac_lane_categories_2010}, all digraph homomorphisms are 
 covariant (see Chapter II-2). However, a special notation is adapted for the 
 digraph homomorphisms from an opposite digraph. Normally, such 
 digraph homomorphisms will be referred to as the contravariant digraph 
 homomorphisms, but this convention will not be enforced.
 \<close>
 
 locale is_dghm = 
   \<Z> \<alpha> + vfsequence \<FF> + HomDom: digraph \<alpha> \<AA> + HomCod: digraph \<alpha> \<BB> 
   for \<alpha> \<AA> \<BB> \<FF> +
   assumes dghm_length[dg_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>"  
     and dghm_HomDom[dg_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and dghm_HomCod[dg_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and dghm_ObjMap_vsv: "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and dghm_ArrMap_vsv: "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and dghm_ObjMap_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and dghm_ObjMap_vrange: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and dghm_ArrMap_vdomain[dg_cs_simps]: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and dghm_ArrMap_is_arr: 
       "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
 
 syntax "_is_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation (input) is_cn_dghm :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   where "is_cn_dghm \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
 
 syntax "_is_cn_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool" 
   (\<open>(_ :/ _ \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation all_dghms :: "V \<Rightarrow> V"
   where "all_dghms \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 abbreviation dghms :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "dghms \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 sublocale is_dghm \<subseteq> ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   by (rule dghm_ObjMap_vsv) (simp add: dg_cs_simps)
 
 sublocale is_dghm \<subseteq> ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
   by (rule dghm_ArrMap_vsv) (simp add: dg_cs_simps)
 
 lemmas [dg_cs_simps] =
   is_dghm.dghm_HomDom
   is_dghm.dghm_HomCod
   is_dghm.dghm_ObjMap_vdomain
   is_dghm.dghm_ArrMap_vdomain
 
 lemma (in is_dghm) dghm_ArrMap_is_arr''[dg_cs_intros]:
   assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and "\<FF>f = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
   shows "\<FF>f : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   using assms(1) unfolding assms(2) by (rule dghm_ArrMap_is_arr)
 
 lemma (in is_dghm) dghm_ArrMap_is_arr'[dg_cs_intros]:
   assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     and "A = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "B = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>\<BB>\<^esub> B"
   using assms(1) unfolding assms(2,3) by (rule dghm_ArrMap_is_arr) 
 
 lemmas [dg_cs_intros] = is_dghm.dghm_ArrMap_is_arr'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_dghm) is_dghm_axioms'[dg_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_dghm_axioms)
 
 mk_ide rf is_dghm_def[unfolded is_dghm_axioms_def]
   |intro is_dghmI|
   |dest is_dghmD[dest]|
   |elim is_dghmE[elim]|
 
 lemmas [dg_cs_intros] = is_dghmD(3,4)
 
 
 text\<open>Elementary properties.\<close>
 
 lemma dghm_eqI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
   shows "\<GG> = \<FF>"
 proof-
   interpret L: is_dghm \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_dghm \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule vsv_eqI)
     have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>" by (cs_concl cs_simp: dg_cs_simps V_cs_simps)
     from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>" 
       by (simp_all add: dg_cs_simps)
     show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a 
       by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
         (auto simp: dghm_field_simps)
   qed (cs_concl cs_simp: dg_cs_simps V_cs_simps cs_intro: V_cs_intros)+
 qed
 
 lemma (in is_dghm) dghm_def: "\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>" by (cs_concl cs_simp: dg_cs_simps V_cs_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
     by (simp add: nat_omega_simps)
   then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
     unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" 
     for a
     by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
       (simp_all add: nat_omega_simps)
 qed (auto simp: vsv_axioms)
 
 lemma (in is_dghm) dghm_ObjMap_app_in_HomCod_Obj[dg_cs_intros]:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   using assms dghm_ObjMap_vrange by (blast dest: ObjMap.vsv_vimageI2)
 
 lemmas [dg_cs_intros] = is_dghm.dghm_ObjMap_app_in_HomCod_Obj
 
 lemma (in is_dghm) dghm_ArrMap_vrange: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
 proof(rule vsv.vsv_vrange_vsubset, unfold dg_cs_simps)
   fix f assume "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   then obtain a b where "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" by auto
   then have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
     by (cs_concl cs_intro: dg_cs_intros)
   then show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" by auto
 qed auto
 
 lemma (in is_dghm) dghm_ArrMap_app_in_HomCod_Arr[dg_cs_intros]:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
   using assms dghm_ArrMap_vrange by (blast dest: ArrMap.vsv_vimageI2)
 
 lemmas [dg_cs_intros] = is_dghm.dghm_ArrMap_app_in_HomCod_Arr
 
 
 text\<open>Size.\<close>
 
 lemma (in is_dghm) dghm_ObjMap_vsubset_Vset: "\<FF>\<lparr>ObjMap\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
   by 
     (
       rule ObjMap.vbrelation_Limit_vsubset_VsetI, 
       insert dghm_ObjMap_vrange HomCod.dg_Obj_vsubset_Vset
     )
     (auto intro!: HomDom.dg_Obj_vsubset_Vset)
 
 lemma (in is_dghm) dghm_ArrMap_vsubset_Vset: "\<FF>\<lparr>ArrMap\<rparr> \<subseteq>\<^sub>\<circ> Vset \<alpha>"
   by 
     (
       rule ArrMap.vbrelation_Limit_vsubset_VsetI, 
       insert dghm_ArrMap_vrange HomCod.dg_Arr_vsubset_Vset
     )
     (auto intro!: HomDom.dg_Arr_vsubset_Vset)
 
 lemma (in is_dghm) dghm_ObjMap_in_Vset: 
   assumes "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>" 
   by (meson assms dghm_ObjMap_vsubset_Vset Vset_in_mono vsubset_in_VsetI)
 
 lemma (in is_dghm) dghm_ArrMap_in_Vset:
   assumes  "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
   by (meson assms dghm_ArrMap_vsubset_Vset Vset_in_mono vsubset_in_VsetI)
 
 lemma (in is_dghm) dghm_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   note [dg_cs_intros] = 
     dghm_ObjMap_in_Vset dghm_ArrMap_in_Vset HomDom.dg_in_Vset HomCod.dg_in_Vset
   from assms(2) show ?thesis
     by (subst dghm_def) 
       (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)
 qed
 
 lemma (in is_dghm) dghm_is_dghm_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<beta>\<^esub> \<BB>"
 proof(rule is_dghmI)
   from is_dghm_axioms assms show "digraph \<beta> \<AA>"
     by (cs_concl cs_intro: digraph.dg_digraph_if_ge_Limit dg_cs_intros)
   from is_dghm_axioms assms show "digraph \<beta> \<BB>"
     by (cs_concl cs_intro: digraph.dg_digraph_if_ge_Limit dg_cs_intros)
 qed (cs_concl cs_simp: dg_cs_simps cs_intro: assms(1) dg_cs_intros V_cs_intros dghm_ObjMap_vrange)+
 
 lemma small_all_dghms[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
 proof(cases \<open>\<Z> \<alpha>\<close>)
   case True
   from is_dghm.dghm_in_Vset show ?thesis
     by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>] subsetI)
       (auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
 next
   case False
   then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
   then show ?thesis by simp
 qed
 
 lemma (in is_dghm) dghm_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
 proof-
   note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], dg_cs_intros] =
     dghm_ObjMap_vsubset_Vset 
     dghm_ArrMap_vsubset_Vset 
   from HomDom.dg_digraph_in_Vset_4 have [dg_cs_intros]:
     "\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   from HomCod.dg_digraph_in_Vset_4 have [dg_cs_intros]:
     "\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   show ?thesis
     by (subst dghm_def, succ_of_numeral)
       (
         cs_concl 
           cs_simp: plus_V_succ_right V_cs_simps dg_cs_simps 
           cs_intro: dg_cs_intros V_cs_intros
       )
 qed
 
 lemma (in \<Z>) all_dghms_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "all_dghms \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
 proof(rule vsubset_in_VsetI)
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   show "all_dghms \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
   proof(intro vsubsetI)
     fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_dghms \<alpha>"
     then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
     interpret is_dghm \<alpha> \<AA> \<BB> \<FF> using \<FF> by simp
     show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule dghm_in_Vset_7)
   qed
   from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
     by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
 qed
 
 lemma small_dghms[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}"
   by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto
 
 
 text\<open>Further elementary properties.\<close>
 
 lemma (in is_dghm) dghm_is_arr_HomCod: 
   assumes "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
   using assms by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+ 
 
 lemma (in is_dghm) dghm_vimage_dghm_ArrMap_vsubset_Hom:
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b \<subseteq>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof(intro vsubsetI)
   fix g assume "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
   then obtain f where "f \<in>\<^sub>\<circ> Hom (\<FF>\<lparr>HomDom\<rparr>) a b" and "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" 
     by (auto simp: dg_cs_simps)
   then show "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     by (simp add: dghm_ArrMap_is_arr dg_cs_simps)
 qed
 
 
 
 subsection\<open>Opposite digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition op_dghm :: "V \<Rightarrow> V"
   where "op_dghm \<FF> =
     [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_dg (\<FF>\<lparr>HomDom\<rparr>), op_dg (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma op_dghm_components[dg_op_simps]:
   shows "op_dghm \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "op_dghm \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "op_dghm \<FF>\<lparr>HomDom\<rparr> = op_dg (\<FF>\<lparr>HomDom\<rparr>)"
     and "op_dghm \<FF>\<lparr>HomCod\<rparr> = op_dg (\<FF>\<lparr>HomCod\<rparr>)"
   unfolding op_dghm_def dghm_field_simps by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_dghm) is_dghm_op: "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
 proof(intro is_dghmI, unfold dg_op_simps)
   show "vfsequence (op_dghm \<FF>)" unfolding op_dghm_def by simp
   show "vcard (op_dghm \<FF>) = 4\<^sub>\<nat>"
     unfolding op_dghm_def by (auto simp: nat_omega_simps)
 qed 
   (
     cs_concl 
       cs_intro: dghm_ObjMap_vrange dg_cs_intros dg_op_intros V_cs_intros 
       cs_simp: dg_cs_simps dg_op_simps
   )+
 
 lemma (in is_dghm) is_dghm_op'[dg_op_intros]:  
   assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>" and "\<alpha>' = \<alpha>"
   shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_dghm_op)
 
 lemmas is_dghm_op[dg_op_intros] = is_dghm.is_dghm_op'
 
 lemma (in is_dghm) dghm_op_dghm_op_dghm[dg_op_simps]: "op_dghm (op_dghm \<FF>) = \<FF>" 
   using is_dghm_axioms
   by 
     (
       cs_concl 
         cs_simp: dg_op_simps 
         cs_intro: dg_op_intros dghm_eqI[where \<FF>=\<FF>]
     )
 
 lemmas dghm_op_dghm_op_dghm[dg_op_simps] = is_dghm.dghm_op_dghm_op_dghm
 
 lemma eq_op_dghm_iff[dg_op_simps]: 
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "op_dghm \<GG> = op_dghm \<FF> \<longleftrightarrow> \<GG> = \<FF>"
 proof
   interpret L: is_dghm \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_dghm \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   assume prems: "op_dghm \<GG> = op_dghm \<FF>"
   show "\<GG> = \<FF>"
   proof(rule dghm_eqI[OF assms])
     from prems R.dghm_op_dghm_op_dghm L.dghm_op_dghm_op_dghm show 
       "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
       by metis+
     from prems R.dghm_op_dghm_op_dghm L.dghm_op_dghm_op_dghm have 
       "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
       by auto
     then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (auto simp: dg_cs_simps)
   qed
 qed auto
 
 
 
 subsection\<open>Composition of covariant digraph homomorphisms\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition dghm_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<close> 55)
   where "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> =
     [\<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>, \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<GG>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma dghm_comp_components:
   shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
     and [dg_shared_cs_simps, dg_cs_simps]: "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>"
     and [dg_shared_cs_simps, dg_cs_simps]: "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
   unfolding dghm_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma dghm_comp_ObjMap_vsv[dg_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis by (cs_concl cs_simp: dghm_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_comp_ObjMap_vdomain[dg_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
         cs_intro: is_dghm.dghm_ObjMap_vrange
     )
 
 lemma dghm_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_comp_components 
         cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros
     )
 
 lemma dghm_comp_ObjMap_app[dg_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   from assms(3) show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>" 
     by 
       (
         cs_concl 
           cs_simp: dghm_comp_components dg_cs_simps V_cs_simps 
           cs_intro: V_cs_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma dghm_comp_ArrMap_vsv[dg_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis by (cs_concl cs_simp: dghm_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_comp_ArrMap_vdomain[dg_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_comp_components dg_cs_simps V_cs_simps
         cs_intro: is_dghm.dghm_ArrMap_vrange
     )
 
 lemma dghm_comp_ArrMap_vrange[dg_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_comp_components 
         cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros
     )
 
 lemma dghm_comp_ArrMap_app[dg_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   from assms(3) show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: dghm_comp_components dg_cs_simps V_cs_simps 
           cs_intro: V_cs_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>Opposite of the composition of covariant digraph homomorphisms\<close>
 
 lemma op_dghm_dghm_comp[dg_op_simps]: 
   "op_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = op_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M op_dghm \<FF>"
   unfolding dghm_comp_def op_dghm_def dghm_field_simps
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma dghm_comp_is_dghm[dg_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
   proof(intro is_dghmI is_dghmI, unfold dg_cs_simps)  
     show "vfsequence (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)" unfolding dghm_comp_def by simp
     show "vcard (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) = 4\<^sub>\<nat>" 
       unfolding dghm_comp_def by (simp add: nat_omega_simps)
     fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     with assms show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : 
       (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed 
     (
       use assms in 
         \<open>
           cs_concl
             cs_intro: dg_cs_intros dghm_comp_ObjMap_vrange 
             cs_simp: dg_cs_simps
         \<close>
     )+
 qed
 
 lemma dghm_comp_assoc[dg_cs_simps]:
   assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>" and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>) \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = \<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)"
 proof(rule dghm_eqI [of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
   show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI)
     show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)" for a 
       using that assms
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (use assms in \<open>cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>)+
   show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI)
     show "(\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = (\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>))\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<HH> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)" for a 
       using that assms
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (use assms in \<open>cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>)+
 qed (use assms in \<open>cs_concl cs_intro: dg_cs_intros\<close>)+
 
 
 
 subsection\<open>Composition of contravariant digraph homomorphisms\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
 
 definition dghm_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ>\<close> 55)
   where "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> =
     [
       \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>,
       \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>,
       op_dg (\<FF>\<lparr>HomDom\<rparr>), 
       \<GG>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma dghm_cn_comp_components:
   shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
     and [dg_cn_cs_simps]: "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_dg (\<FF>\<lparr>HomDom\<rparr>)"
     and [dg_cn_cs_simps]: "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
   unfolding dghm_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map: two contravariant digraph homomorphisms\<close>
 
 lemma dghm_cn_comp_ObjMap_vsv[dg_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_cn_comp_ObjMap_vdomain[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
         cs_intro: is_dghm.dghm_ObjMap_vrange 
     )
 
 lemma dghm_cn_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components
         cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros 
     )
 
 lemma dghm_cn_comp_ObjMap_app[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps 
           cs_intro: V_cs_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map: two contravariant digraph homomorphisms\<close>
 
 lemma dghm_cn_comp_ArrMap_vsv[dg_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_cn_comp_ArrMap_vdomain[dg_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
         cs_intro: is_dghm.dghm_ArrMap_vrange 
     )
 
 lemma dghm_cn_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components
         cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros 
     )
 
 lemma dghm_cn_comp_ArrMap_app[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps 
           cs_intro: V_cs_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>Object map: contravariant and covariant digraph homomorphisms\<close>
 
 lemma dghm_cn_cov_comp_ObjMap_vsv[dg_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_cn_cov_comp_ObjMap_vdomain[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
         cs_intro: is_dghm.dghm_ObjMap_vrange 
     )
 
 lemma dghm_cn_cov_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   using assms
   by
     (
       cs_concl
         cs_simp: dghm_cn_comp_components
         cs_intro: is_dghm.dghm_ObjMap_vrange V_cs_intros 
     )
 
 lemma dghm_cn_cov_comp_ObjMap_app[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   from assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>" 
     by 
       (
         cs_concl 
           cs_simp: dghm_cn_comp_components dg_cs_simps V_cs_simps 
           cs_intro: V_cs_intros dg_op_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>Arrow map: contravariant and covariant digraph homomorphisms\<close>
 
 lemma dghm_cn_cov_comp_ArrMap_vsv[dg_cn_cs_intros]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by (cs_concl cs_simp: dghm_cn_comp_components cs_intro: V_cs_intros)
 qed
 
 lemma dghm_cn_cov_comp_ArrMap_vdomain[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components dg_cs_simps dg_op_simps V_cs_simps
         cs_intro: is_dghm.dghm_ArrMap_vrange 
     )
 
 lemma dghm_cn_cov_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
   using assms 
   by 
     (
       cs_concl 
         cs_simp: dghm_cn_comp_components
         cs_intro: is_dghm.dghm_ArrMap_vrange V_cs_intros 
     )
 
 lemma dghm_cn_cov_comp_ArrMap_app[dg_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   from assms(3) show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>" 
     by 
       (
         cs_concl 
           cs_simp: dghm_cn_comp_components dg_cs_simps V_cs_simps 
           cs_intro: V_cs_intros dg_op_intros dg_cs_intros
       )
 qed
 
 
 subsubsection\<open>
 Opposite of the contravariant composition of the digraph homomorphisms
 \<close>
 
 lemma op_dghm_dghm_cn_comp[dg_op_simps]: 
   "op_dghm (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = op_dghm \<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> op_dghm \<FF>"
   unfolding op_dghm_def dghm_cn_comp_def dghm_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma dghm_cn_comp_is_dghm[dg_cn_cs_intros]:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
   assumes "digraph \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<AA>: digraph \<alpha> \<AA> by (rule assms(1))
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> using assms(2) by auto
   interpret R: is_dghm \<alpha> \<open>op_dg \<AA>\<close> \<BB> \<FF> using assms(3) by auto
   show ?thesis
   proof(intro is_dghmI, unfold dg_op_simps dg_cs_simps dg_cn_cs_simps)
     show "vfsequence (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)" unfolding dghm_cn_comp_def by auto
     show "vcard (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = 4\<^sub>\<nat>"
       unfolding dghm_cn_comp_def by (simp add: nat_omega_simps)
     fix f a b assume "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     with assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
       (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: dg_cn_cs_simps  
             cs_intro: dg_cs_intros dg_op_intros
         )
   qed 
     ( 
       cs_concl 
         cs_simp: dg_cs_simps dg_cn_cs_simps 
         cs_intro: dghm_cn_comp_ObjMap_vrange dg_cs_intros dg_cn_cs_intros
     )+
 qed
 
 lemma dghm_cn_cov_comp_is_dghm[dg_cn_cs_intros]:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
   assumes "\<GG> : \<BB> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_dghm \<alpha> \<open>op_dg \<BB>\<close> \<CC> \<GG> by (rule assms(1))
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof(intro is_dghmI, unfold dg_op_simps dg_cs_simps)
     show "vfsequence (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)" unfolding dghm_cn_comp_def by simp
     show "vcard (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>) = 4\<^sub>\<nat>" 
       unfolding dghm_cn_comp_def by (auto simp: nat_omega_simps)
     fix f b a assume "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
     with assms show "(\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : 
       (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       by (cs_concl cs_simp: dg_cn_cs_simps dg_op_simps cs_intro: dg_cs_intros)
   qed
     ( 
       cs_concl 
         cs_simp: dg_cs_simps dg_cn_cs_simps
         cs_intro:
           dghm_cn_cov_comp_ObjMap_vrange 
           dg_cs_intros dg_cn_cs_intros dg_op_intros 
     )+
 qed
 
 lemma dghm_cov_cn_comp_is_dghm:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<^sub>D\<^sub>G\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms by (rule dghm_comp_is_dghm)
 
 
 
 subsection\<open>Identity digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition dghm_id :: "V \<Rightarrow> V"
   where "dghm_id \<CC> = [vid_on (\<CC>\<lparr>Obj\<rparr>), vid_on (\<CC>\<lparr>Arr\<rparr>), \<CC>, \<CC>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma dghm_id_components:
   shows "dghm_id \<CC>\<lparr>ObjMap\<rparr> = vid_on (\<CC>\<lparr>Obj\<rparr>)" 
     and "dghm_id \<CC>\<lparr>ArrMap\<rparr> = vid_on (\<CC>\<lparr>Arr\<rparr>)" 
     and [dg_shared_cs_simps, dg_cs_simps]: "dghm_id \<CC>\<lparr>HomDom\<rparr> = \<CC>"
     and [dg_shared_cs_simps, dg_cs_simps]: "dghm_id \<CC>\<lparr>HomCod\<rparr> = \<CC>" 
   unfolding dghm_id_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda dghm_id_components(1)[folded VLambda_vid_on]
   |vsv dghm_id_ObjMap_vsv[dg_shared_cs_intros, dg_cs_intros]|
   |vdomain dghm_id_ObjMap_vdomain[dg_shared_cs_simps, dg_cs_simps]|
   |app dghm_id_ObjMap_app[dg_shared_cs_simps, dg_cs_simps]|
 
 lemma dghm_id_ObjMap_vrange[dg_shared_cs_simps, dg_cs_simps]: 
   "\<R>\<^sub>\<circ> (dghm_id \<CC>\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
   unfolding dghm_id_components by simp
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda dghm_id_components(2)[folded VLambda_vid_on]
   |vsv dghm_id_ArrMap_vsv[dg_shared_cs_intros, dg_cs_intros]|
   |vdomain dghm_id_ArrMap_vdomain[dg_shared_cs_simps, dg_cs_simps]|
   |app dghm_id_ArrMap_app[dg_shared_cs_simps, dg_cs_simps]|
 
 lemma dghm_id_ArrMap_vrange[dg_shared_cs_simps, dg_cs_simps]: 
   "\<R>\<^sub>\<circ> (dghm_id \<CC>\<lparr>ArrMap\<rparr>) = \<CC>\<lparr>Arr\<rparr>"
   unfolding dghm_id_components by simp
 
 
 subsubsection\<open>Opposite identity digraph homomorphism\<close>
 
 lemma op_dghm_dghm_id[dg_op_simps]: "op_dghm (dghm_id \<CC>) = dghm_id (op_dg \<CC>)"
   unfolding dghm_id_def op_dg_def op_dghm_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>An identity digraph homomorphism is a digraph homomorphism\<close>
 
 lemma (in digraph) dg_dghm_id_is_dghm: "dghm_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_dghmI, unfold dg_cs_simps)
   show "vfsequence (dghm_id \<CC>)" unfolding dghm_id_def by simp
   show "vcard (dghm_id \<CC>) = 4\<^sub>\<nat>"
     unfolding dghm_id_def by (simp add: nat_omega_simps)
 qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
 
 lemma (in digraph) dg_dghm_id_is_dghm': 
   assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
   shows "dghm_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   unfolding assms by (rule dg_dghm_id_is_dghm)
 
 lemmas [dg_cs_intros] = digraph.dg_dghm_id_is_dghm'
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_dghm) dghm_dghm_comp_dghm_id_left: "dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = \<FF>"
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 proof(rule dghm_eqI [of \<alpha> \<AA> \<BB> _ \<AA> \<BB>])
   show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI)
     show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>)" for a 
       using that 
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
   show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI)
     show "(dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((dghm_id \<BB> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>)" for a 
       using that 
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
 qed (cs_concl cs_simp: cs_intro: dg_cs_intros)+
 
 lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_id_left
 
 lemma (in is_dghm) dghm_dghm_comp_dghm_id_right: "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA> = \<FF>"
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 proof(rule dghm_eqI [of \<alpha> \<AA> \<BB> _ \<AA> \<BB>])
   show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
   proof(rule vsv_eqI)
     show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ObjMap\<rparr>)" for a 
       using that 
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
   show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
   proof(rule vsv_eqI)
     show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M dghm_id \<AA>)\<lparr>ArrMap\<rparr>)" for a 
       using that 
       by 
         (cs_prems cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
         (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
   qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros)+
 qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
 
 lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_id_right
 
 
 
 subsection\<open>Constant digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>
 
 definition dghm_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "dghm_const \<CC> \<DD> a f =
     [vconst_on (\<CC>\<lparr>Obj\<rparr>) a, vconst_on (\<CC>\<lparr>Arr\<rparr>) f, \<CC>, \<DD>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma dghm_const_components:
   shows "dghm_const \<CC> \<DD> a f\<lparr>ObjMap\<rparr> = vconst_on (\<CC>\<lparr>Obj\<rparr>) a" 
     and "dghm_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr> = vconst_on (\<CC>\<lparr>Arr\<rparr>) f" 
     and [dg_shared_cs_simps, dg_cs_simps]: "dghm_const \<CC> \<DD> a f\<lparr>HomDom\<rparr> = \<CC>"
     and [dg_shared_cs_simps, dg_cs_simps]: "dghm_const \<CC> \<DD> a f\<lparr>HomCod\<rparr> = \<DD>" 
   unfolding dghm_const_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda dghm_const_components(1)[folded VLambda_vconst_on]
   |vsv dghm_const_ObjMap_vsv[dg_shared_cs_intros, dg_cs_intros]|
   |vdomain dghm_const_ObjMap_vdomain[dg_shared_cs_simps, dg_cs_simps]|
   |app dghm_const_ObjMap_app[dg_shared_cs_simps, dg_cs_simps]|
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda dghm_const_components(2)[folded VLambda_vconst_on]
   |vsv dghm_const_ArrMap_vsv[dg_shared_cs_intros, dg_cs_intros]|
   |vdomain dghm_const_ArrMap_vdomain[dg_shared_cs_simps, dg_cs_simps]|
   |app dghm_const_ArrMap_app[dg_shared_cs_simps, dg_cs_simps]|
 
 
 subsubsection\<open>Opposite constant digraph homomorphism\<close>
 
 lemma op_dghm_dghm_const[dg_op_simps]:
   "op_dghm (dghm_const \<CC> \<DD> a f) = dghm_const (op_dg \<CC>) (op_dg \<DD>) a f"
   unfolding dghm_const_def op_dg_def op_dghm_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>A constant digraph homomorphism is a digraph homomorphism\<close>
 
 lemma dghm_const_is_dghm: 
   assumes "digraph \<alpha> \<CC>" and "digraph \<alpha> \<DD>" and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
   shows "dghm_const \<CC> \<DD> a f : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
   interpret \<DD>: digraph \<alpha> \<DD> by (rule assms(2))
   show ?thesis
   proof(intro is_dghmI)
     show "vfsequence (dghm_const \<CC> \<DD> a f)"
       unfolding dghm_const_def by simp
     show "vcard (dghm_const \<CC> \<DD> a f) = 4\<^sub>\<nat>"
       unfolding dghm_const_def by (simp add: nat_omega_simps)
   qed 
     (
       use assms in 
         \<open>
           cs_concl 
             cs_simp: dghm_const_components(1) dg_cs_simps
             cs_intro: V_cs_intros dg_cs_intros
         \<close>
     )+
 qed
 
 lemma dghm_const_is_dghm'[dg_cs_intros]: 
   assumes "digraph \<alpha> \<CC>" 
     and "digraph \<alpha> \<DD>" 
     and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
   shows "dghm_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms(1-3) unfolding assms(4,5) by (rule dghm_const_is_dghm)
 
 
+subsubsection\<open>Further properties\<close>
+
+lemma (in is_dghm) dghm_dghm_comp_dghm_const[dg_cs_simps]:
+  assumes "digraph \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a"
+  shows "dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_const \<AA> \<CC> a f"
+proof(rule dghm_eqI)
+  interpret \<CC>: digraph \<alpha> \<CC> by (rule assms(1))
+  from assms(2) show "dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_intro: dg_cs_intros)
+  with assms(2) have ObjMap_dom_lhs: 
+    "\<D>\<^sub>\<circ> ((dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
+    and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: dg_cs_simps)+
+  from assms(2) show "dghm_const \<AA> \<CC> a f : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_intro: dg_cs_intros)
+  with assms(2) have ObjMap_dom_rhs: 
+    "\<D>\<^sub>\<circ> (dghm_const \<AA> \<CC> a f\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
+    and ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (dghm_const \<AA> \<CC> a f\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
+    by (cs_concl cs_simp: dg_cs_simps)+
+  show "(dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = dghm_const \<AA> \<CC> a f\<lparr>ObjMap\<rparr>"
+    by (rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
+      (use assms(2) in \<open>cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>)+
+  show "(dghm_const \<BB> \<CC> a f \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = dghm_const \<AA> \<CC> a f\<lparr>ArrMap\<rparr>"
+    by (rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
+      (use assms(2) in \<open>cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros\<close>)+
+qed simp_all
+
+lemmas [dg_cs_simps] = is_dghm.dghm_dghm_comp_dghm_const
+
+
 
 subsection\<open>Faithful digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_ft_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
   assumes ft_dghm_v11_on_Hom: 
     "\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
 
 syntax "_is_ft_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_ft_dghm) is_ft_dghm_axioms'[dghm_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_ft_dghm_axioms)
 
 mk_ide rf is_ft_dghm_def[unfolded is_ft_dghm_axioms_def]
   |intro is_ft_dghmI|
   |dest is_ft_dghmD[dest]|
   |elim is_ft_dghmE[elim]|
 
 lemmas [dghm_cs_intros] = is_ft_dghmD(1)
 
 
 subsubsection\<open>Opposite faithful digraph homomorphism\<close>
 
 lemma (in is_ft_dghm) ft_dghm_op_dghm_is_ft_dghm: 
   "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
   by 
     (
       rule is_ft_dghmI, 
       unfold dg_op_simps, 
       cs_concl cs_simp: cs_intro: dg_cs_intros dg_op_intros
     )
     (auto simp: ft_dghm_v11_on_Hom)
 
 lemma (in is_ft_dghm) ft_dghm_op_dghm_is_ft_dghm'[dg_op_intros]: 
   assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
   shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule ft_dghm_op_dghm_is_ft_dghm)
 
 lemmas ft_dghm_op_dghm_is_ft_dghm[dg_op_intros] = 
   is_ft_dghm.ft_dghm_op_dghm_is_ft_dghm'
 
 
 subsubsection\<open>
 The composition of faithful digraph homomorphisms is a faithful
 digraph homomorphism.
 \<close>
 
 lemma dghm_comp_is_ft_dghm[dghm_cs_intros]:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof- 
   interpret L: is_ft_dghm \<alpha> \<BB> \<CC> \<GG> using assms(1) by auto
   interpret R: is_ft_dghm \<alpha> \<AA> \<BB> \<FF> using assms(2) by auto 
   have inj: 
     "\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> ; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
     for a b
   proof-
     assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     then have \<GG>_hom_\<BB>: 
       "v11 (\<GG>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>))" 
       by (intro L.ft_dghm_v11_on_Hom) 
         (cs_concl cs_intro: dg_cs_intros)+
     have "v11 (\<GG>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b))"
     proof(intro v11_vlrestriction_vsubset[OF \<GG>_hom_\<BB>] vsubsetI)
       fix g assume "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b" 
       then obtain f where f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" and g_def: "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" 
         by auto
       from f show "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         by (cs_concl cs_simp: g_def cs_intro: dg_cs_intros)
     qed
     then show "v11 ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
       unfolding dghm_comp_components
       by (intro v11_vlrestriction_vcomp) (auto simp: R.ft_dghm_v11_on_Hom prems)
   qed
   then show "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
     by (intro is_ft_dghmI, cs_concl cs_intro: dg_cs_intros) auto
 qed
 
 
 
 subsection\<open>Full digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_fl_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
   assumes fl_dghm_surj_on_Hom: 
     "\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 
 syntax "_is_fl_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_fl_dghm) is_fl_dghm_axioms'[dghm_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_fl_dghm_axioms)
 
 mk_ide rf is_fl_dghm_def[unfolded is_fl_dghm_axioms_def]
   |intro is_fl_dghmI|
   |dest is_fl_dghmD[dest]|
   |elim is_fl_dghmE[elim]|
 
 lemmas [dghm_cs_intros] = is_fl_dghmD(1)
 
 
 subsubsection\<open>Opposite full digraph homomorphism\<close>
 
 lemma (in is_fl_dghm) fl_dghm_op_dghm_is_fl_dghm:
   "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"  
   by 
     (
       rule is_fl_dghmI,
       unfold dg_op_simps, 
       cs_concl cs_intro: dg_cs_intros dg_op_intros
     )
     (auto simp: fl_dghm_surj_on_Hom)
 
 lemma (in is_fl_dghm) fl_dghm_op_dghm_is_fl_dghm'[dg_op_intros]:
   assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
   shows "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
   unfolding assms by (rule fl_dghm_op_dghm_is_fl_dghm)
 
 lemmas fl_dghm_op_dghm_is_fl_dghm[dg_op_intros] = 
   is_fl_dghm.fl_dghm_op_dghm_is_fl_dghm'
 
 
 subsubsection\<open>
 The composition of full digraph homomorphisms is a full digraph homomorphism
 \<close>
 
 lemma dghm_comp_is_fl_dghm[dghm_cs_intros]:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof- 
   interpret L: is_fl_dghm \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
   interpret R: is_fl_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   have surj: 
     "\<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> 
       (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = 
         Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     for a b
   proof-
     assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     have surj_\<FF>: "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" 
       by (rule R.fl_dghm_surj_on_Hom[OF prems])
     from prems L.is_dghm_axioms R.is_dghm_axioms have comp_Obj:
       "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
       "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>"
       by (auto simp: dg_cs_simps)
     have "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = \<GG>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"
       unfolding dghm_comp_components by (simp add: vcomp_vimage)
     also from prems have 
       "\<dots> = Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
       unfolding surj_\<FF> comp_Obj
       by 
         (
           simp add: 
             prems(2) L.fl_dghm_surj_on_Hom R.dghm_ObjMap_app_in_HomCod_Obj
         )
     finally show "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) =
       Hom \<CC> ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) ((\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
       by simp
   qed
   show ?thesis  
     by (rule is_fl_dghmI, cs_concl cs_intro: dg_cs_intros)
       (auto simp: surj)
 qed
 
 
 
 subsection\<open>Fully faithful digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_ff_dghm = is_ft_dghm \<alpha> \<AA> \<BB> \<FF> + is_fl_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF>
 
 syntax "_is_ff_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_ff_dghm) is_ff_dghm_axioms'[dghm_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_ff_dghm_axioms)
 
 mk_ide rf is_ff_dghm_def
   |intro is_ff_dghmI|
   |dest is_ff_dghmD[dest]|
   |elim is_ff_dghmE[elim]|
 
 lemmas [dghm_cs_intros] = is_ff_dghmD
 
 
 subsubsection\<open>Opposite fully faithful digraph homomorphism.\<close>
 
 lemma (in is_ff_dghm) ff_dghm_op_dghm_is_ff_dghm: 
   "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_dg \<BB>"  
   by (rule is_ff_dghmI) (cs_concl cs_intro: dg_op_intros)+
 
 lemma (in is_ff_dghm) ff_dghm_op_dghm_is_ff_dghm'[dg_op_intros]: 
   assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
   shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'" 
   unfolding assms by (rule ff_dghm_op_dghm_is_ff_dghm)
 
 lemmas ff_dghm_op_dghm_is_ff_dghm[dg_op_intros] = 
   is_ff_dghm.ff_dghm_op_dghm_is_ff_dghm
 
 
 subsubsection\<open>
 The composition of fully faithful digraph homomorphisms is 
 a fully faithful digraph homomorphism.
 \<close>
 
 lemma dghm_comp_is_ff_dghm[dghm_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms 
   by (intro is_ff_dghmI, elim is_ff_dghmE) (cs_concl cs_intro: dghm_cs_intros)
 
 
 
 subsection\<open>Isomorphism of digraphs\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_iso_dghm = is_dghm \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
   assumes iso_dghm_ObjMap_v11: "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and iso_dghm_ArrMap_v11: "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and iso_dghm_ObjMap_vrange[dghm_cs_simps]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and iso_dghm_ArrMap_vrange[dghm_cs_simps]: "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
 
 syntax "_is_iso_dghm" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_dghm \<alpha> \<AA> \<BB> \<FF>"
 
 sublocale is_iso_dghm \<subseteq> ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
   by (cs_concl cs_simp: dghm_cs_simps dg_cs_simps cs_intro: iso_dghm_ObjMap_v11)+
 
 sublocale is_iso_dghm \<subseteq> ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   by (cs_concl cs_simp: dghm_cs_simps dg_cs_simps cs_intro: iso_dghm_ArrMap_v11)+
 
 lemmas [dghm_cs_simps] = 
   is_iso_dghm.iso_dghm_ObjMap_vrange
   is_iso_dghm.iso_dghm_ArrMap_vrange
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_iso_dghm) is_iso_dghm_axioms'[dghm_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_dghm_axioms)
 
 mk_ide rf is_iso_dghm_def[unfolded is_iso_dghm_axioms_def]
   |intro is_iso_dghmI|
   |dest is_iso_dghmD[dest]|
   |elim is_iso_dghmE[elim]|
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_iso_dghm) iso_dghm_Obj_HomDom_if_Obj_HomCod[elim]:
   assumes "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   obtains a where "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and "b = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
   using assms ObjMap.vrange_atD iso_dghm_ObjMap_vrange by blast
 
 lemma (in is_iso_dghm) iso_dghm_Arr_HomDom_if_Arr_HomCod[elim]:
   assumes "g \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
   obtains f where "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
   using assms ArrMap.vrange_atD iso_dghm_ArrMap_vrange by blast
 
 lemma (in is_iso_dghm) iso_dghm_ObjMap_eqE[elim]:
   assumes "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "a = b \<Longrightarrow> P"
   shows P
   using assms ObjMap.v11_eq_iff by auto
 
 lemma (in is_iso_dghm) iso_dghm_ArrMap_eqE[elim]:
   assumes "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
     and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     and "g \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
     and "f = g \<Longrightarrow> P"
   shows P
   using assms ArrMap.v11_eq_iff by auto
 
 sublocale is_iso_dghm \<subseteq> is_ft_dghm 
   by (intro is_ft_dghmI, cs_concl cs_intro: dg_cs_intros) auto
 
 sublocale is_iso_dghm \<subseteq> is_fl_dghm
 proof
   fix a b assume [intro]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
   show "\<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   proof(intro vsubset_antisym vsubsetI)
     fix g assume prems: "g \<in>\<^sub>\<circ> Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     then have g: "g : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" by auto
     then have dom_g: "\<BB>\<lparr>Dom\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
       and cod_g: "\<BB>\<lparr>Cod\<rparr>\<lparr>g\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
       by blast+
     from prems obtain f 
       where [intro, simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" and g_def: "g = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" 
       by auto
     then obtain a' b' where f: "f : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"  by blast
     then have "g : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>" 
       by (cs_concl cs_simp: g_def dg_cs_simps cs_intro: dg_cs_intros)
     with g have "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>" and "\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       by (metis HomCod.dg_is_arrE cod_g)+
     with f have "a = \<AA>\<lparr>Dom\<rparr>\<lparr>f\<rparr>" "b = \<AA>\<lparr>Cod\<rparr>\<lparr>f\<rparr>" by auto (*slow*)
     with f show "g \<in>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> Hom \<AA> a b"  
       by (auto simp: g_def HomDom.dg_is_arrD(4,5) ArrMap.vsv_vimageI1)
   qed (metis ArrMap.vsv_vimageE dghm_ArrMap_is_arr' in_Hom_iff)
 qed
 
 sublocale is_iso_dghm \<subseteq> is_ff_dghm by unfold_locales
 
 lemmas (in is_iso_dghm) iso_dghm_is_ff_dghm = is_ff_dghm_axioms
 lemmas [dghm_cs_intros] = is_iso_dghm.iso_dghm_is_ff_dghm
 
 
 subsubsection\<open>Opposite digraph isomorphisms\<close>
 
 lemma (in is_iso_dghm) is_iso_dghm_op: 
   "op_dghm \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_dg \<BB>"
   by (intro is_iso_dghmI, unfold dg_op_simps)
     (
       cs_concl 
         cs_simp: dghm_cs_simps cs_intro: V_cs_intros dg_cs_intros dg_op_intros
     )+
 
 lemma (in is_iso_dghm) is_iso_dghm_op': 
   assumes "\<AA>' = op_dg \<AA>" and "\<BB>' = op_dg \<BB>"
   shows "op_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_dghm_op)
   
 lemmas is_iso_dghm_op[dg_op_intros] = is_iso_dghm.is_iso_dghm_op'
 
 
 subsubsection\<open>
 The composition of isomorphisms of digraphs is an isomorphism of digraphs
 \<close>
  
 lemma dghm_comp_is_iso_dghm[dghm_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
 proof- 
   interpret \<FF>: is_iso_dghm \<alpha> \<AA> \<BB> \<FF> using assms by auto
   interpret \<GG>: is_iso_dghm \<alpha> \<BB> \<CC> \<GG> using assms by auto
   show ?thesis
     by (intro is_iso_dghmI, unfold dghm_comp_components)
       (
         cs_concl 
           cs_simp: V_cs_simps dg_cs_simps dghm_cs_simps 
           cs_intro: dg_cs_intros V_cs_intros
       )+
 qed
 
 
 subsubsection\<open>An identity digraph homomorphism is an isomorphism of digraphs.\<close>
 
 lemma (in digraph) dg_dghm_id_is_iso_dghm: "dghm_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
   by (rule is_iso_dghmI) (simp_all add: dg_dghm_id_is_dghm dghm_id_components)
 
 lemma (in digraph) dg_dghm_id_is_iso_dghm'[dghm_cs_intros]:
   assumes "\<AA>' = \<CC>" and "\<BB>' = \<CC>"
   shows "dghm_id \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule dg_dghm_id_is_iso_dghm)
 
 lemmas [dghm_cs_intros] = digraph.dg_dghm_id_is_iso_dghm'
 
 
 
 subsection\<open>Inverse digraph homomorphism\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition inv_dghm :: "V \<Rightarrow> V"
   where "inv_dghm \<FF> = [(\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>, (\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>, \<FF>\<lparr>HomCod\<rparr>, \<FF>\<lparr>HomDom\<rparr>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma inv_dghm_components:
   shows "inv_dghm \<FF>\<lparr>ObjMap\<rparr> = (\<FF>\<lparr>ObjMap\<rparr>)\<inverse>\<^sub>\<circ>" 
     and "inv_dghm \<FF>\<lparr>ArrMap\<rparr> = (\<FF>\<lparr>ArrMap\<rparr>)\<inverse>\<^sub>\<circ>" 
     and [dghm_cs_simps]: "inv_dghm \<FF>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
     and [dghm_cs_simps]: "inv_dghm \<FF>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomDom\<rparr>" 
   unfolding inv_dghm_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma (in is_iso_dghm) inv_dghm_ObjMap_v11[dghm_cs_intros]:
   "v11 (inv_dghm \<FF>\<lparr>ObjMap\<rparr>)"
   unfolding inv_dghm_components by (cs_concl cs_intro: V_cs_intros)
 
 lemmas [dghm_cs_intros] = is_iso_dghm.inv_dghm_ObjMap_v11
 
 lemma (in is_iso_dghm) inv_dghm_ObjMap_vdomain[dghm_cs_simps]:
   "\<D>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
   unfolding inv_dghm_components by (cs_concl cs_simp: dghm_cs_simps V_cs_simps)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_vdomain
 
 lemma (in is_iso_dghm) inv_dghm_ObjMap_app[dghm_cs_simps]:
   assumes "a' = \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr> = a" 
   unfolding inv_dghm_components
   by (metis assms ObjMap.vconverse_atI ObjMap.vsv_vconverse vsv.vsv_appI)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_app
 
 lemma (in is_iso_dghm) inv_dghm_ObjMap_vrange[dghm_cs_simps]: 
   "\<R>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
   unfolding inv_dghm_components by (cs_concl cs_simp: dg_cs_simps V_cs_simps)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ObjMap_vrange
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma (in is_iso_dghm) inv_dghm_ArrMap_v11[dghm_cs_intros]:
   "v11 (inv_dghm \<FF>\<lparr>ArrMap\<rparr>)"
   unfolding inv_dghm_components by (cs_concl cs_intro: V_cs_intros)
 
 lemmas [dghm_cs_intros] = is_iso_dghm.inv_dghm_ArrMap_v11
 
 lemma (in is_iso_dghm) inv_dghm_ArrMap_vdomain[dghm_cs_simps]:
   "\<D>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   unfolding inv_dghm_components by (cs_concl cs_simp: dghm_cs_simps V_cs_simps)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_vdomain
 
 lemma (in is_iso_dghm) inv_dghm_ArrMap_app[dghm_cs_simps]:
   assumes "a' = \<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>a'\<rparr> = a" 
   unfolding inv_dghm_components
   by (metis assms ArrMap.vconverse_atI ArrMap.vsv_vconverse vsv.vsv_appI)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_app
 
 lemma (in is_iso_dghm) inv_dghm_ArrMap_vrange[dghm_cs_simps]: 
   "\<R>\<^sub>\<circ> (inv_dghm \<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
   unfolding inv_dghm_components by (cs_concl cs_simp: dg_cs_simps V_cs_simps)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.inv_dghm_ArrMap_vrange
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_iso_dghm) iso_dghm_ObjMap_inv_dghm_ObjMap_app[dghm_cs_simps]: 
   assumes "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<FF>\<lparr>ObjMap\<rparr>\<lparr>inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr> = a"
   using assms by (cs_concl cs_simp: inv_dghm_components V_cs_simps)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.iso_dghm_ObjMap_inv_dghm_ObjMap_app
 
 lemma (in is_iso_dghm) iso_dghm_ArrMap_inv_dghm_ArrMap_app[dghm_cs_simps]:
   assumes "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr> = f"
   using assms
   by (cs_concl cs_simp: inv_dghm_components V_cs_simps cs_intro: dg_cs_intros)
 
 lemmas [dghm_cs_simps] = is_iso_dghm.iso_dghm_ArrMap_inv_dghm_ArrMap_app
 
 lemma (in is_iso_dghm) iso_dghm_HomDom_is_arr_conv:
   assumes "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" 
   by 
     (
       metis 
         assms
         HomDom.dg_is_arrE 
         is_arr_def 
         dghm_ArrMap_is_arr 
         iso_dghm_ObjMap_eqE
     )
 
 lemma (in is_iso_dghm) iso_dghm_HomCod_is_arr_conv:
   assumes "f \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
     and "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     and "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" 
   by 
     (
       metis 
         assms 
         dghm_ArrMap_is_arr' 
         is_arrI 
         iso_dghm_ArrMap_inv_dghm_ArrMap_app 
         iso_dghm_ObjMap_inv_dghm_ObjMap_app
     )
 
 
 
 subsection\<open>An isomorphism of digraphs is an isomorphism in the category \<open>GRPH\<close>\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 lemma is_arr_isomorphism_is_iso_dghm: 
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
     and "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> = dghm_id \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 proof(intro is_iso_dghmI)
 
   interpret L: is_dghm \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
   interpret R: is_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
 
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: dg_cs_intros)
 
   show "v11 (\<FF>\<lparr>ObjMap\<rparr>)" 
   proof(rule R.ObjMap.vsv_valeq_v11I)
     fix a b assume prems[simp]: 
       "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" "\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     from assms(1,2) have "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" 
       by (simp add: dg_cs_simps)
     then show "a = b" by (simp add: assms(3) dghm_id_components)
   qed
 
   show "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
   proof(rule R.ArrMap.vsv_valeq_v11I)
     fix a b 
     assume prems[simp]: 
       "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" "b \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>b\<rparr>"
     then have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
       by (cs_concl cs_intro: dg_cs_intros)
     with R.dghm_ArrMap_vsv L.dghm_ArrMap_vsv R.dghm_ArrMap_vrange have 
       "(\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr>\<lparr>b\<rparr>" 
       unfolding dghm_comp_components by (simp add: dg_cs_simps)
     then show "a = b" by (simp add: assms(3) dghm_id_components)
   qed
 
   show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
   proof(intro vsubset_antisym vsubsetI)
     from R.dghm_ObjMap_vrange show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<Longrightarrow> a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for a
       by auto
   next
     fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
     then have a_def[symmetric]: "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = a" 
       unfolding assms(4) dghm_id_components by simp
     from prems show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
       by (subst a_def)
         (cs_concl cs_intro: V_cs_intros dg_cs_intros cs_simp: dg_cs_simps)
   qed
 
   show "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   proof(intro vsubset_antisym vsubsetI)
     from R.dghm_ArrMap_vrange show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<Longrightarrow> a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" for a
       by auto
   next
     fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>" 
     then have a_def[symmetric]: "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = a" 
       unfolding assms(4) dghm_id_components by simp
     with prems show "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)" 
       by (subst a_def)
         (cs_concl cs_intro: V_cs_intros dg_cs_intros cs_simp: dg_cs_simps)
   qed
 
 qed
 
 lemma is_iso_dghm_is_arr_isomorphism:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows [dghm_cs_intros]: "inv_dghm \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
     and "inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
     and "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF> = dghm_id \<BB>"
 proof-
 
   let ?\<GG> = \<open>inv_dghm \<FF>\<close>
 
   interpret is_iso_dghm \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
 
   show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
   proof(intro is_iso_dghmI is_dghmI, unfold dghm_cs_simps)
     show "vfsequence (inv_dghm \<FF>)" unfolding inv_dghm_def by auto
     show "vcard (inv_dghm \<FF>) = 4\<^sub>\<nat>"
       unfolding inv_dghm_def by (simp add: nat_omega_simps)
     show "inv_dghm \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> inv_dghm \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f
       using that 
       by 
         (
           intro iso_dghm_HomDom_is_arr_conv, 
           use nothing in \<open>unfold inv_dghm_components\<close>
         )
         (
           cs_concl 
             cs_simp: V_cs_simps dghm_cs_simps dg_cs_simps 
             cs_intro: dg_cs_intros V_cs_intros 
         )+
   qed 
     (
       cs_concl 
         cs_simp: dg_cs_simps 
         cs_intro: dg_cs_intros V_cs_intros dghm_cs_intros
     )+
 
   show "inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF> = dghm_id \<AA>"
   proof(rule dghm_eqI[of \<alpha> \<AA> \<AA> _ \<AA> \<AA>])
     show "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ObjMap\<rparr> = dghm_id \<AA>\<lparr>ObjMap\<rparr>"
       unfolding inv_dghm_components dghm_comp_components dghm_id_components
       by (rule ObjMap.v11_vcomp_vconverse)    
     show "(inv_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>)\<lparr>ArrMap\<rparr> = dghm_id \<AA>\<lparr>ArrMap\<rparr>"
       unfolding inv_dghm_components dghm_comp_components dghm_id_components
       by (rule ArrMap.v11_vcomp_vconverse)    
   qed (use \<GG> in \<open>cs_concl cs_intro: dghm_cs_intros\<close>)
 
   show "\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF> = dghm_id \<BB>"
   proof(rule dghm_eqI[of \<alpha> \<BB> \<BB> _ \<BB> \<BB>])
     show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF>)\<lparr>ObjMap\<rparr> = dghm_id \<BB>\<lparr>ObjMap\<rparr>"
       unfolding inv_dghm_components dghm_comp_components dghm_id_components
       by (rule ObjMap.v11_vcomp_vconverse')
     show "(\<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M inv_dghm \<FF>)\<lparr>ArrMap\<rparr> = dghm_id \<BB>\<lparr>ArrMap\<rparr>"
       unfolding inv_dghm_components dghm_comp_components dghm_id_components
       by (rule ArrMap.v11_vcomp_vconverse')
   qed (use \<GG> in \<open>cs_concl cs_intro: dghm_cs_intros\<close>)
 
 qed
 
 
 
 subsection\<open>Isomorphic digraphs\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale iso_digraph = 
   fixes \<alpha> \<AA> \<BB> :: V
   assumes iso_digraph_is_iso_dghm: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 
 notation iso_digraph (infixl "\<approx>\<^sub>D\<^sub>G\<index>" 50)
 
 sublocale iso_digraph \<subseteq> HomDom: digraph \<alpha> \<AA> + HomCod: digraph \<alpha> \<BB>
   using iso_digraph_is_iso_dghm by auto
 
 
 text\<open>Rules.\<close>
 
 lemma iso_digraphI':
   assumes "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms iso_digraph.intro by auto
 
 lemma iso_digraphI:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms unfolding iso_digraph_def by auto
 
 lemma iso_digraphD[dest]:
   assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   using assms unfolding iso_digraph_def by simp_all
 
 lemma iso_digraphE[elim]:
   assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" 
   obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms by auto
 
 
 subsubsection\<open>A digraph isomorphism is an equivalence relation\<close>
 
 lemma iso_digraph_refl: 
   assumes "digraph \<alpha> \<AA>" 
   shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
 proof(rule iso_digraphI[of _ _ _ \<open>dghm_id \<AA>\<close>])
   interpret digraph \<alpha> \<AA> by (rule assms)
   show "dghm_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" by (rule dg_dghm_id_is_iso_dghm)
 qed
 
 lemma iso_digraph_sym[sym]:
   assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<BB> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   interpret iso_digraph \<alpha> \<AA> \<BB> by (rule assms)
   from iso_digraph_is_iso_dghm obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
     by clarsimp
   then have "inv_dghm \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" 
     by (simp add: is_iso_dghm_is_arr_isomorphism(1))
   then show ?thesis by (cs_concl cs_intro: dghm_cs_intros iso_digraphI)
 qed
 
 lemma iso_digraph_trans[trans]:
   assumes "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: iso_digraph \<alpha> \<AA> \<BB> by (rule assms(1))
   interpret R: iso_digraph \<alpha> \<BB> \<CC> by (rule assms(2))
   from L.iso_digraph_is_iso_dghm R.iso_digraph_is_iso_dghm show ?thesis 
     by (meson dghm_comp_is_iso_dghm iso_digraph.intro)
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
--- a/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
+++ b/thys/CZH_Foundations/czh_semicategories/CZH_SMC_Semifunctor.thy
@@ -1,2099 +1,2120 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Semifunctor\<close>
 theory CZH_SMC_Semifunctor
   imports 
     CZH_DG_DGHM
     CZH_SMC_Semicategory
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems smcf_cs_simps
 named_theorems smcf_cs_intros
 
 named_theorems smc_cn_cs_simps
 named_theorems smc_cn_cs_intros
 
 lemmas [smc_cs_simps] = dg_shared_cs_simps
 lemmas [smc_cs_intros] = dg_shared_cs_intros
 
 
 subsubsection\<open>Slicing\<close>
 
 definition smcf_dghm :: "V \<Rightarrow> V"
   where "smcf_dghm \<CC> = 
     [\<CC>\<lparr>ObjMap\<rparr>, \<CC>\<lparr>ArrMap\<rparr>, smc_dg (\<CC>\<lparr>HomDom\<rparr>), smc_dg (\<CC>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma smcf_dghm_components:
   shows [slicing_simps]: "smcf_dghm \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and [slicing_simps]: "smcf_dghm \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and [slicing_commute]: "smcf_dghm \<FF>\<lparr>HomDom\<rparr> = smc_dg (\<FF>\<lparr>HomDom\<rparr>)"
     and [slicing_commute]: "smcf_dghm \<FF>\<lparr>HomCod\<rparr> = smc_dg (\<FF>\<lparr>HomCod\<rparr>)"
   unfolding smcf_dghm_def dghm_field_simps by (auto simp: nat_omega_simps)
 
 
 
 subsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 See Chapter I-3 in \cite{mac_lane_categories_2010} and the description
 of the concept of a digraph homomorphism in the previous chapter.
 \<close>
 
 locale is_semifunctor = 
   \<Z> \<alpha> +
   vfsequence \<FF> + 
   HomDom: semicategory \<alpha> \<AA> + 
   HomCod: semicategory \<alpha> \<BB> 
   for \<alpha> \<AA> \<BB> \<FF> +
   assumes smcf_length[smc_cs_simps]: "vcard \<FF> = 4\<^sub>\<nat>" 
     and smcf_is_dghm[slicing_intros]: 
       "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>" 
     and smcf_HomDom[smc_cs_simps]: "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and smcf_HomCod[smc_cs_simps]: "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and smcf_ArrMap_Comp[smc_cs_simps]: "\<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
 
 syntax "_is_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation (input) is_cn_semifunctor :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   where "is_cn_semifunctor \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
 
 syntax "_is_cn_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool" 
   (\<open>(_ :/ _ \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 abbreviation all_smcfs :: "V \<Rightarrow> V"
   where "all_smcfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 abbreviation smcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "smcfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 
 lemmas [smc_cs_simps] =
   is_semifunctor.smcf_HomDom
   is_semifunctor.smcf_HomCod
   is_semifunctor.smcf_ArrMap_Comp
 
 lemma smcf_is_dghm'[slicing_intros]:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<AA>' = smc_dg \<AA>"
     and "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1) unfolding assms(2,3) by (rule is_semifunctor.smcf_is_dghm)
 
 lemma cn_dghm_comp_is_dghm: 
   assumes "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "smcf_dghm \<FF> : op_dg (smc_dg \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
   using assms 
   unfolding slicing_simps slicing_commute
   by (cs_concl cs_intro: slicing_intros)
 
 lemma cn_dghm_comp_is_dghm'[slicing_intros]: 
   assumes "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<AA>' = op_dg (smc_dg \<AA>)"
     and "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>'"
   using assms(1) unfolding assms(2,3) by (rule cn_dghm_comp_is_dghm)
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_semifunctor) is_semifunctor_axioms'[smc_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_semifunctor_axioms)
 
 mk_ide rf is_semifunctor_def[unfolded is_semifunctor_axioms_def]
   |intro is_semifunctorI|
   |dest is_semifunctorD[dest]|
   |elim is_semifunctorE[elim]|
 
 lemmas [smc_cs_intros] =
   is_semifunctorD(3,4)
 
 lemma is_semifunctorI':
   assumes "\<Z> \<alpha>" 
     and "vfsequence \<FF>" 
     and "semicategory \<alpha> \<AA>"
     and "semicategory \<alpha> \<BB>" 
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   by (intro is_semifunctorI is_dghmI, unfold smcf_dghm_components slicing_simps)
     (simp_all add: assms smcf_dghm_def nat_omega_simps semicategory.smc_digraph)
 
 lemma is_semifunctorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<Z> \<alpha>" 
     and "vfsequence \<FF>" 
     and "semicategory \<alpha> \<AA>"
     and "semicategory \<alpha> \<BB>" 
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
   by
     (
       simp_all add: 
         is_semifunctorD(2-9)[OF assms] 
         is_dghmD[OF is_semifunctorD(6)[OF assms], unfolded slicing_simps]
     )
 
 lemma is_semifunctorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<Z> \<alpha>" 
     and "vfsequence \<FF>" 
     and "semicategory \<alpha> \<AA>"
     and "semicategory \<alpha> \<BB>" 
     and "vcard \<FF> = 4\<^sub>\<nat>"
     and "\<FF>\<lparr>HomDom\<rparr> = \<AA>"
     and "\<FF>\<lparr>HomCod\<rparr> = \<BB>"
     and "vsv (\<FF>\<lparr>ObjMap\<rparr>)"
     and "vsv (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
     and "\<And>a b f. f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<And>b c g a f. \<lbrakk> g : b \<mapsto>\<^bsub>\<AA>\<^esub> c; f : a \<mapsto>\<^bsub>\<AA>\<^esub> b \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
   using assms by (simp add: is_semifunctorD')
 
 
 text\<open>Slicing.\<close>
 
 context is_semifunctor
 begin
 
 interpretation dghm: is_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
   by (rule smcf_is_dghm)
 
 sublocale ObjMap: vsv \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   by (rule dghm.ObjMap.vsv_axioms[unfolded slicing_simps])
 sublocale ArrMap: vsv \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   by (rule dghm.ArrMap.vsv_axioms[unfolded slicing_simps])
 
 lemmas_with [unfolded slicing_simps]:
   smcf_ObjMap_vsv = dghm.dghm_ObjMap_vsv
   and smcf_ArrMap_vsv = dghm.dghm_ArrMap_vsv
   and smcf_ObjMap_vdomain[smc_cs_simps] = dghm.dghm_ObjMap_vdomain
   and smcf_ObjMap_vrange = dghm.dghm_ObjMap_vrange
   and smcf_ArrMap_vdomain[smc_cs_simps] = dghm.dghm_ArrMap_vdomain
   and smcf_ArrMap_is_arr = dghm.dghm_ArrMap_is_arr
   and smcf_ArrMap_is_arr''[smc_cs_intros] = dghm.dghm_ArrMap_is_arr''
   and smcf_ArrMap_is_arr'[smc_cs_intros] = dghm.dghm_ArrMap_is_arr'
   and smcf_ObjMap_app_in_HomCod_Obj[smc_cs_intros] = 
     dghm.dghm_ObjMap_app_in_HomCod_Obj
   and smcf_ArrMap_vrange = dghm.dghm_ArrMap_vrange
   and smcf_ArrMap_app_in_HomCod_Arr[smc_cs_intros] = 
     dghm.dghm_ArrMap_app_in_HomCod_Arr
   and smcf_ObjMap_vsubset_Vset = dghm.dghm_ObjMap_vsubset_Vset
   and smcf_ArrMap_vsubset_Vset = dghm.dghm_ArrMap_vsubset_Vset
   and smcf_ObjMap_in_Vset = dghm.dghm_ObjMap_in_Vset
   and smcf_ArrMap_in_Vset = dghm.dghm_ArrMap_in_Vset
   and smcf_is_dghm_if_ge_Limit = dghm.dghm_is_dghm_if_ge_Limit
   and smcf_is_arr_HomCod = dghm.dghm_is_arr_HomCod
   and smcf_vimage_dghm_ArrMap_vsubset_Hom = 
     dghm.dghm_vimage_dghm_ArrMap_vsubset_Hom
 
 end
 
 lemmas [smc_cs_simps] =
   is_semifunctor.smcf_ObjMap_vdomain
   is_semifunctor.smcf_ArrMap_vdomain
 
 lemmas [smc_cs_intros] =
   is_semifunctor.smcf_ObjMap_app_in_HomCod_Obj
   is_semifunctor.smcf_ArrMap_app_in_HomCod_Arr
   is_semifunctor.smcf_ArrMap_is_arr'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma cn_smcf_ArrMap_Comp[smc_cs_simps]:
   assumes "semicategory \<alpha> \<AA>"
     and "\<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b"
     and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
 proof-
   from assms(3,4) have gf:
     "\<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_smc \<AA>\<^esub> f\<rparr>"
     by
       (
         force
           intro: is_semifunctor.smcf_ArrMap_Comp[OF assms(2), symmetric]
           simp: slicing_simps smc_op_simps
       )
   from assms show ?thesis
     unfolding gf by (cs_concl cs_simp: smc_op_simps) 
 qed
 
 lemma smcf_eqI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
   shows "\<GG> = \<FF>"
 proof-
   interpret L: is_semifunctor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_semifunctor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule vsv_eqI)
     have dom: "\<D>\<^sub>\<circ> \<GG> = 4\<^sub>\<nat>" by (cs_concl cs_simp: smc_cs_simps V_cs_simps)
     show "\<D>\<^sub>\<circ> \<GG> = \<D>\<^sub>\<circ> \<FF>" by (cs_concl cs_simp: smc_cs_simps V_cs_simps)
     from assms(5,6) have sup: "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>" 
       by (simp_all add: smc_cs_simps)
     show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<GG> \<Longrightarrow> \<GG>\<lparr>a\<rparr> = \<FF>\<lparr>a\<rparr>" for a 
       by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
         (auto simp: dghm_field_simps)
   qed auto
 qed
 
 lemma smcf_dghm_eqI:
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
     and "smcf_dghm \<GG> = smcf_dghm \<FF>"
   shows "\<GG> = \<FF>"
 proof(rule smcf_eqI)
   from assms(5) have 
     "smcf_dghm \<GG>\<lparr>ObjMap\<rparr> = smcf_dghm \<FF>\<lparr>ObjMap\<rparr>"
     "smcf_dghm \<GG>\<lparr>ArrMap\<rparr> = smcf_dghm \<FF>\<lparr>ArrMap\<rparr>"
     by simp_all
   then show "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     unfolding slicing_simps by simp_all
 qed (auto intro: assms(1,2) simp: assms)
 
 lemma (in is_semifunctor) smcf_def: 
   "\<FF> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> \<FF> = 4\<^sub>\<nat>" by (cs_concl cs_simp: smc_cs_simps V_cs_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> [\<FF>\<lparr>Obj\<rparr>, \<FF>\<lparr>Arr\<rparr>, \<FF>\<lparr>Dom\<rparr>, \<FF>\<lparr>Cod\<rparr>]\<^sub>\<circ> = 4\<^sub>\<nat>"
     by (simp add: nat_omega_simps)
   then show "\<D>\<^sub>\<circ> \<FF> = \<D>\<^sub>\<circ> [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>"
     unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> \<FF> \<Longrightarrow> \<FF>\<lparr>a\<rparr> = [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, \<FF>\<lparr>HomDom\<rparr>, \<FF>\<lparr>HomCod\<rparr>]\<^sub>\<circ>\<lparr>a\<rparr>" 
     for a
     by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
       (simp_all add: nat_omega_simps)
 qed (auto simp: vsv_axioms)
 
 lemma (in is_semifunctor) smcf_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF> \<in>\<^sub>\<circ> Vset \<beta>"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   note [smc_cs_intros] = 
     smcf_ObjMap_in_Vset 
     smcf_ArrMap_in_Vset 
     HomDom.smc_in_Vset 
     HomCod.smc_in_Vset
   from assms(2) show ?thesis
     by (subst smcf_def) 
       (cs_concl cs_simp: smc_cs_simps cs_intro: smc_cs_intros V_cs_intros)
 qed
 
 lemma (in is_semifunctor) smcf_is_semifunctor_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
   by (rule is_semifunctorI)
     (
       simp_all add: 
         assms 
         vfsequence_axioms
         smcf_is_dghm_if_ge_Limit
         HomDom.smc_semicategory_if_ge_Limit
         HomCod.smc_semicategory_if_ge_Limit
         smc_cs_simps
     )
 
 lemma small_all_smcfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
 proof(cases \<open>\<Z> \<alpha>\<close>)
   case True
   from is_semifunctor.smcf_in_Vset show ?thesis
     by (intro down[of _ \<open>Vset (\<alpha> + \<omega>)\<close>]) 
       (auto simp: True \<Z>.\<Z>_Limit_\<alpha>\<omega> \<Z>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>.intro \<Z>.\<Z>_\<alpha>_\<alpha>\<omega>)
 next
   case False
   then have "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>} = {}" by auto
   then show ?thesis by simp
 qed
 
 lemma (in is_semifunctor) smcf_in_Vset_7: "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
 proof-
   note [folded VPow_iff, folded Vset_succ[OF Ord_\<alpha>], smc_cs_intros] =
     smcf_ObjMap_vsubset_Vset 
     smcf_ArrMap_vsubset_Vset
   from HomDom.smc_semicategory_in_Vset_4 have [smc_cs_intros]:
     "\<AA> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   from HomCod.smc_semicategory_in_Vset_4 have [smc_cs_intros]:
     "\<BB> \<in>\<^sub>\<circ> Vset (succ (succ (succ (succ \<alpha>))))"
     by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
   show ?thesis
     by (subst smcf_def, succ_of_numeral)
       (
         cs_concl 
           cs_simp: plus_V_succ_right V_cs_simps smc_cs_simps 
           cs_intro: smc_cs_intros V_cs_intros
       )
 qed
 
 lemma (in \<Z>) all_smcfs_in_Vset: 
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "all_smcfs \<alpha> \<in>\<^sub>\<circ> Vset \<beta>"
 proof(rule vsubset_in_VsetI)
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   show "all_smcfs \<alpha> \<subseteq>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)"
   proof(intro vsubsetI)
     fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_smcfs \<alpha>"
     then obtain \<AA> \<BB> where \<FF>: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
     then interpret is_semifunctor \<alpha> \<AA> \<BB> \<FF> .
     show "\<FF> \<in>\<^sub>\<circ> Vset (\<alpha> + 7\<^sub>\<nat>)" by (rule smcf_in_Vset_7)
   qed
   from assms(2) show "Vset (\<alpha> + 7\<^sub>\<nat>) \<in>\<^sub>\<circ> Vset \<beta>"
     by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
 qed
 
 lemma small_smcfs[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}"
   by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto
 
 
 
 subsection\<open>Opposite semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter II-2 in \cite{mac_lane_categories_2010}.\<close>
 
 definition op_smcf :: "V \<Rightarrow> V"
   where "op_smcf \<FF> =
     [\<FF>\<lparr>ObjMap\<rparr>, \<FF>\<lparr>ArrMap\<rparr>, op_smc (\<FF>\<lparr>HomDom\<rparr>), op_smc (\<FF>\<lparr>HomCod\<rparr>)]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma op_smcf_components[smc_op_simps]:
   shows "op_smcf \<FF>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>"
     and "op_smcf \<FF>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
     and "op_smcf \<FF>\<lparr>HomDom\<rparr> = op_smc (\<FF>\<lparr>HomDom\<rparr>)"
     and "op_smcf \<FF>\<lparr>HomCod\<rparr> = op_smc (\<FF>\<lparr>HomCod\<rparr>)"
   unfolding op_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma op_dghm_smcf_dghm[slicing_commute]: 
   "op_dghm (smcf_dghm \<FF>) = smcf_dghm (op_smcf \<FF>)"
 proof(rule vsv_eqI)
   have dom_lhs: "\<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) = 4\<^sub>\<nat>"
     unfolding op_dghm_def by (auto simp: nat_omega_simps)
   have dom_rhs: "\<D>\<^sub>\<circ> (smcf_dghm (op_smcf \<FF>)) = 4\<^sub>\<nat>"
     unfolding smcf_dghm_def by (auto simp: nat_omega_simps)
   show "\<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) = \<D>\<^sub>\<circ> (smcf_dghm (op_smcf \<FF>))"
     unfolding dom_lhs dom_rhs by simp
   show "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (op_dghm (smcf_dghm \<FF>)) \<Longrightarrow>
     op_dghm (smcf_dghm \<FF>)\<lparr>a\<rparr> = smcf_dghm (op_smcf \<FF>)\<lparr>a\<rparr>"
     for a
     by 
       (
         unfold dom_lhs, 
         elim_in_numeral,
         unfold smcf_dghm_def op_smcf_def op_dghm_def dghm_field_simps
       ) 
       (auto simp: nat_omega_simps slicing_simps slicing_commute)
 qed (auto simp: smcf_dghm_def op_dghm_def)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_semifunctor) is_semifunctor_op:
   "op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
 proof(intro is_semifunctorI)
   show "vfsequence (op_smcf \<FF>)" unfolding op_smcf_def by simp
   show "vcard (op_smcf \<FF>) = 4\<^sub>\<nat>" 
     unfolding op_smcf_def by (auto simp: nat_omega_simps)
   fix g b c f a assume "g : b \<mapsto>\<^bsub>op_smc \<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>op_smc \<AA>\<^esub> b"
   then have "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b" and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"  
     unfolding smc_op_simps by simp_all
   with is_semifunctor_axioms show 
     "op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_smc \<AA>\<^esub> f\<rparr> =
       op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>op_smc \<BB>\<^esub> op_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: smc_op_simps smc_cs_simps 
           cs_intro: smc_op_intros smc_cs_intros
       )
 qed 
   (
     auto simp: 
       smc_cs_simps
       smc_op_simps
       slicing_simps
       slicing_commute[symmetric]
       is_dghm.is_dghm_op 
       smcf_is_dghm
       HomCod.semicategory_op 
       HomDom.semicategory_op
   )
 
 lemma (in is_semifunctor) is_semifunctor_op':  
   assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>" and "\<alpha>' = \<alpha>"
   shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_semifunctor_op)
 
 lemmas is_semifunctor_op'[smc_op_intros] = is_semifunctor.is_semifunctor_op'
 
 lemma (in is_semifunctor) smcf_op_smcf_op_smcf[smc_op_simps]: 
   "op_smcf (op_smcf \<FF>) = \<FF>" 
 proof(rule smcf_eqI, unfold smc_op_simps)
   show "op_smcf (op_smcf \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     by 
       (
         metis 
           HomCod.smc_op_smc_op_smc 
           HomDom.smc_op_smc_op_smc 
           is_semifunctor.is_semifunctor_op 
           is_semifunctor_op
       )
 qed (simp_all add: is_semifunctor_axioms)
 
 lemmas smcf_op_smcf_op_smcf[smc_op_simps] = is_semifunctor.smcf_op_smcf_op_smcf
 
 lemma eq_op_smcf_iff[smc_op_simps]: 
   assumes "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
   shows "op_smcf \<GG> = op_smcf \<FF> \<longleftrightarrow> \<GG> = \<FF>"
 proof
   interpret L: is_semifunctor \<alpha> \<AA> \<BB> \<GG> by (rule assms(1))
   interpret R: is_semifunctor \<alpha> \<CC> \<DD> \<FF> by (rule assms(2))
   assume prems: "op_smcf \<GG> = op_smcf \<FF>"
   show "\<GG> = \<FF>"
   proof(rule smcf_eqI[OF assms])
     from prems R.smcf_op_smcf_op_smcf L.smcf_op_smcf_op_smcf show 
       "\<GG>\<lparr>ObjMap\<rparr> = \<FF>\<lparr>ObjMap\<rparr>" and "\<GG>\<lparr>ArrMap\<rparr> = \<FF>\<lparr>ArrMap\<rparr>"
       by metis+
     from prems R.smcf_op_smcf_op_smcf L.smcf_op_smcf_op_smcf have 
       "\<GG>\<lparr>HomDom\<rparr> = \<FF>\<lparr>HomDom\<rparr>" "\<GG>\<lparr>HomCod\<rparr> = \<FF>\<lparr>HomCod\<rparr>"
       by auto
     then show "\<AA> = \<CC>" "\<BB> = \<DD>" by (simp_all add: smc_cs_simps)
   qed
 qed auto
 
 
 
 subsection\<open>Composition of covariant semifunctors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 abbreviation (input) smcf_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl "\<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F" 55)
   where "smcf_comp \<equiv> dghm_comp"
 
 
 text\<open>Slicing.\<close>
 
 lemma smcf_dghm_smcf_comp[slicing_commute]: 
   "smcf_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<FF> = smcf_dghm (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)"
   unfolding dghm_comp_def smcf_dghm_def dghm_field_simps 
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemma smcf_comp_ObjMap_vsv[smc_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ObjMap_vsv
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ObjMap_vdomain[smc_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ObjMap_vdomain
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ObjMap_vrange
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ObjMap_app[smc_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and [simp]: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ObjMap_app
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute, 
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma smcf_comp_ArrMap_vsv[smc_cs_intros]: 
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis 
     by 
       (
         rule dghm_comp_ArrMap_vsv
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ArrMap_vdomain[smc_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ArrMap_vdomain
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ArrMap_vrange
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute
           ]
       )
 qed
 
 lemma smcf_comp_ArrMap_app[smc_cs_simps]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and [simp]: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_comp_ArrMap_app
           [
             OF L.smcf_is_dghm R.smcf_is_dghm, 
             unfolded slicing_simps slicing_commute,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma smcf_comp_is_semifunctor[smc_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule is_semifunctorI, unfold dghm_comp_components(3,4))
     show "vfsequence (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)" by (simp add: dghm_comp_def)
     show "vcard (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = 4\<^sub>\<nat>"  
       unfolding dghm_comp_def by (simp add: nat_omega_simps)
     fix g b c f a assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     with assms show "(\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = 
       (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       by (cs_concl cs_simp: smc_cs_simps cs_intro: smc_cs_intros)
   qed 
     (
       auto 
         simp: slicing_commute[symmetric] smc_cs_simps smc_cs_intros 
         intro: dg_cs_intros slicing_intros
     )
 qed 
 
 lemma smcf_comp_assoc[smc_cs_simps]:
   assumes "\<HH> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "(\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>)"
 proof(rule smcf_eqI[of \<alpha> \<AA> \<DD> _ \<AA> \<DD>])
   interpret \<HH>: is_semifunctor \<alpha> \<CC> \<DD> \<HH> by (rule assms(1)) 
   interpret \<GG>: is_semifunctor \<alpha> \<BB> \<CC> \<GG> by (rule assms(2)) 
   interpret \<FF>: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(3)) 
   from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms \<HH>.is_semifunctor_axioms 
   show "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>" 
     and "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"  
     by (auto intro: smc_cs_intros)
 qed (simp_all add: dghm_comp_components vcomp_assoc)
 
 lemma op_smcf_smcf_comp[smc_op_simps]: 
   "op_smcf (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = op_smcf \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F op_smcf \<FF>"
   unfolding dghm_comp_def op_smcf_def dghm_field_simps 
   by (simp add: nat_omega_simps)
 
 
 
 subsection\<open>Composition of contravariant semifunctors\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
 
 definition smcf_cn_comp :: "V \<Rightarrow> V \<Rightarrow> V" (infixl \<open>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ>\<close> 55)
   where "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> =
     [
       \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>, 
       \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>, 
       op_smc (\<FF>\<lparr>HomDom\<rparr>), 
       \<GG>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma smcf_cn_comp_components:
   shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr> = \<GG>\<lparr>ObjMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ObjMap\<rparr>"
     and "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr> = \<GG>\<lparr>ArrMap\<rparr> \<circ>\<^sub>\<circ> \<FF>\<lparr>ArrMap\<rparr>"
     and [smc_cn_cs_simps]: "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomDom\<rparr> = op_smc (\<FF>\<lparr>HomDom\<rparr>)"
     and [smc_cn_cs_simps]: "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>HomCod\<rparr> = \<GG>\<lparr>HomCod\<rparr>"
   unfolding smcf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 
 text\<open>Slicing.\<close>
 
 lemma smcf_dghm_smcf_cn_comp[slicing_commute]: 
   "smcf_dghm \<GG> \<^sub>D\<^sub>G\<^sub>H\<^sub>M\<circ> smcf_dghm \<FF> = smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)"
   unfolding dghm_cn_comp_def smcf_cn_comp_def smcf_dghm_def  
   by (simp add: nat_omega_simps slicing_commute dghm_field_simps)
 
 
 subsubsection\<open>Object map: two contravariant semifunctors\<close>
 
 lemma smcf_cn_comp_ObjMap_vsv[smc_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ObjMap_vsv
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ObjMap_vdomain[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ObjMap_vdomain
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ObjMap_vrange
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ObjMap_app[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ObjMap_app
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps, 
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map: two contravariant semifunctors\<close>
 
 lemma smcf_cn_comp_ArrMap_vsv[smc_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ArrMap_vsv
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ArrMap_vdomain[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ArrMap_vdomain
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ArrMap_vrange
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_comp_ArrMap_app[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_comp_ArrMap_app
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Object map: contravariant and covariant semifunctors\<close>
 
 lemma smcf_cn_cov_comp_ObjMap_vsv[smc_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ObjMap_vsv
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ObjMap_vdomain[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ObjMap_vdomain
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ObjMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ObjMap_vrange
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ObjMap_app[smc_cn_cs_simps]:
     assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ObjMap_app
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Arrow map: contravariant and covariant semifunctors\<close>
 
 lemma smcf_cn_cov_comp_ArrMap_vsv[smc_cn_cs_intros]: 
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "vsv ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>)"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ArrMap_vsv
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]]
               R.smcf_is_dghm[unfolded slicing_commute[symmetric]],
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ArrMap_vdomain[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<D>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ArrMap_vdomain
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ArrMap_vrange:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<R>\<^sub>\<circ> ((\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>) \<subseteq>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ArrMap_vrange
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps
           ]
       )
 qed
 
 lemma smcf_cn_cov_comp_ArrMap_app[smc_cn_cs_simps]:
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
   shows "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<GG>\<lparr>ArrMap\<rparr>\<lparr>\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<rparr>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> by (rule assms(1)) 
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
     by 
       (
         rule dghm_cn_cov_comp_ArrMap_app
           [
             OF 
               L.smcf_is_dghm[unfolded slicing_commute[symmetric]] 
               R.smcf_is_dghm,
             unfolded slicing_commute slicing_simps,
             OF assms(3)
           ]
       )
 qed
 
 
 subsubsection\<open>Opposite of the contravariant composition of semifunctors\<close>
 
 lemma op_smcf_smcf_cn_comp[smc_op_simps]: 
   "op_smcf (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) = op_smcf \<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> op_smcf \<FF>"
   unfolding op_smcf_def smcf_cn_comp_def dghm_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma smcf_cn_comp_is_semifunctor[smc_cn_cs_intros]:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
   assumes "semicategory \<alpha> \<AA>" and "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> 
     rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a 
     by (rule assms(2)) (simp_all add: smc_op_simps)
   interpret R: is_semifunctor \<alpha> \<open>op_smc \<AA>\<close> \<BB> \<FF> 
     rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a
     by (rule assms(3)) (simp_all add: smc_op_simps)
   interpret \<AA>: semicategory \<alpha> \<AA> by (rule assms(1))
   show ?thesis
   proof(rule is_semifunctorI, unfold smcf_cn_comp_components(3,4) smc_op_simps)
     from assms show "smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
       by 
         (
           cs_concl 
             cs_simp: slicing_commute[symmetric] 
             cs_intro: dg_cn_cs_intros slicing_intros
         )
     fix g b c f a assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> c" "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
     with assms show "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f\<rparr> = 
       (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: smc_cs_simps smc_cn_cs_simps smc_op_simps 
             cs_intro: smc_cs_intros
         )
   qed 
     (
       auto simp: 
         smcf_cn_comp_def 
         nat_omega_simps 
         smc_cs_simps
         smc_op_simps 
         smc_cs_intros
     )
 qed
 
 lemma smcf_cn_cov_comp_is_semifunctor[smc_cs_intros]:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
   assumes "\<GG> : \<BB> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret L: is_semifunctor \<alpha> \<open>op_smc \<BB>\<close> \<CC> \<GG> 
     rewrites "f : b \<mapsto>\<^bsub>op_smc \<CC>'\<^esub> a = f : a \<mapsto>\<^bsub>\<CC>'\<^esub> b" for \<CC>' f b a 
     by (rule assms(1)) (simp_all add: smc_op_simps)
   interpret R: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
   show ?thesis
   proof(rule is_semifunctorI, unfold smcf_cn_comp_components(3,4) smc_op_simps)
     from assms show 
       "smcf_dghm (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) : smc_dg (op_smc \<AA>) \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
       by 
         (
           cs_concl 
             cs_simp: slicing_commute[symmetric]
             cs_intro: dg_cn_cs_intros slicing_intros
         )
     show "vfsequence (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)" unfolding smcf_cn_comp_def by simp
     show "vcard (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>) = 4\<^sub>\<nat>"
       unfolding smcf_cn_comp_def by (auto simp: nat_omega_simps)
     show "op_smc (\<FF>\<lparr>HomDom\<rparr>) = op_smc \<AA>" by (simp add: smc_cs_simps)
     show "\<GG>\<lparr>HomCod\<rparr> = \<CC>" by (simp add: smc_cs_simps)
     fix g b c f a assume "g : c \<mapsto>\<^bsub>\<AA>\<^esub> b" "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a"
     with assms show 
       "(\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g\<rparr> = 
         (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<GG> \<^sub>S\<^sub>M\<^sub>C\<^sub>F\<circ> \<FF>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: smc_cs_simps smc_cn_cs_simps smc_op_simps 
             cs_intro: smc_cs_intros
         )
   qed (auto intro: smc_cs_intros smc_op_intros)
 qed
 
 lemma smcf_cov_cn_comp_is_semifunctor[smc_cn_cs_intros]:
   \<comment>\<open>See section 1.2 in \cite{bodo_categories_1970}.\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<^sub>S\<^sub>M\<^sub>C\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms by (rule smcf_comp_is_semifunctor)
 
 
 
 subsection\<open>Identity semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation (input) smcf_id :: "V \<Rightarrow> V" where "smcf_id \<equiv> dghm_id"
 
 
 text\<open>Slicing.\<close>
 
 lemma smcf_dghm_smcf_id[slicing_commute]: 
   "dghm_id (smc_dg \<CC>) = smcf_dghm (smcf_id \<CC>)"
   unfolding dghm_id_def smc_dg_def smcf_dghm_def dghm_field_simps dg_field_simps
   by (simp add: nat_omega_simps)
 
 context semicategory
 begin
 
 interpretation dg: digraph \<alpha> \<open>smc_dg \<CC>\<close> by (rule smc_digraph)
 
 lemmas_with [unfolded slicing_simps]:
   smc_dghm_id_is_dghm = dg.dg_dghm_id_is_dghm
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 lemmas [smc_cs_simps] = dghm_id_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemmas [smc_cs_simps] = dghm_id_ArrMap_app
 
 
 subsubsection\<open>Opposite identity semifunctor\<close>
 
 lemma op_smcf_smcf_id[smc_op_simps]: "op_smcf (smcf_id \<CC>) = smcf_id (op_smc \<CC>)"
   unfolding dghm_id_def op_smc_def op_smcf_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>An identity semifunctor is a semifunctor\<close>
 
 lemma (in semicategory) smc_smcf_id_is_semifunctor: "smcf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(rule is_semifunctorI, unfold dghm_id_components)
   from smc_dghm_id_is_dghm show 
     "smcf_dghm (smcf_id \<CC>) : smc_dg \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
     by (auto simp: slicing_simps slicing_commute)
   fix g b c f a assume "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
   then show "vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = 
     vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> vid_on (\<CC>\<lparr>Arr\<rparr>)\<lparr>f\<rparr>"
     by (metis smc_is_arrD(1) smc_Comp_is_arr vid_on_eq_atI)
 qed (auto simp: semicategory_axioms dghm_id_def nat_omega_simps)
 
 lemma (in semicategory) smc_smcf_id_is_semifunctor': 
   assumes "\<AA> = \<CC>" and "\<BB> = \<CC>"
   shows "smcf_id \<CC> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   unfolding assms by (rule smc_smcf_id_is_semifunctor)
 
 lemmas [smc_cs_intros] = semicategory.smc_smcf_id_is_semifunctor'
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_semifunctor) smcf_smcf_comp_smcf_id_left[smc_cs_simps]:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
   "smcf_id \<BB> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = \<FF>"
   by (rule smcf_eqI, unfold dghm_id_components dghm_comp_components)
     (auto simp: smcf_ObjMap_vrange smcf_ArrMap_vrange intro: smc_cs_intros)
 
 lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_id_left
 
 lemma (in is_semifunctor) smcf_smcf_comp_smcf_id_right[smc_cs_simps]: 
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
   "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F smcf_id \<AA> = \<FF>"
   by (rule smcf_eqI, unfold dghm_id_components dghm_comp_components)
     (
       auto 
         simp: smcf_ObjMap_vrange smcf_ArrMap_vrange smc_cs_simps
         intro: smc_cs_intros
     )
 
 lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_id_right
 
 
 
 subsection\<open>Constant semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter III-3 in \cite{mac_lane_categories_2010}.\<close>
 
 abbreviation (input) smcf_const :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "smcf_const \<equiv> dghm_const"
 
 
 text\<open>Slicing.\<close>
 
 lemma smcf_dghm_smcf_const[slicing_commute]: 
   "dghm_const (smc_dg \<CC>) (smc_dg \<DD>) a f = smcf_dghm (smcf_const \<CC> \<DD> a f)"
   unfolding 
     dghm_const_def smc_dg_def smcf_dghm_def dghm_field_simps dg_field_simps
   by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>Object map\<close>
 
 lemmas [smc_cs_simps] = 
   dghm_const_ObjMap_app 
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemmas [smc_cs_simps] = 
   dghm_const_ArrMap_app
 
 
 subsubsection\<open>Opposite constant semifunctor\<close>
 
 lemma op_smcf_smcf_const[smc_op_simps]:
   "op_smcf (smcf_const \<CC> \<DD> a f) = smcf_const (op_smc \<CC>) (op_smc \<DD>) a f"
   unfolding dghm_const_def op_smc_def op_smcf_def dghm_field_simps dg_field_simps
   by (auto simp: nat_omega_simps)
 
 
 subsubsection\<open>A constant semifunctor is a semifunctor\<close>
 
 lemma smcf_const_is_semifunctor: 
   assumes "semicategory \<alpha> \<CC>"
     and "semicategory \<alpha> \<DD>" 
     and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a" 
     and [simp]: "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f = f"
   shows "smcf_const \<CC> \<DD> a f : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
   interpret \<CC>: semicategory \<alpha> \<CC> by (rule assms(1))
   interpret \<DD>: semicategory \<alpha> \<DD> by (rule assms(2))
   show ?thesis
   proof(intro is_semifunctorI, tactic\<open>distinct_subgoals_tac\<close>)
     from assms show 
       "smcf_dghm (dghm_const \<CC> \<DD> a f) : smc_dg \<CC> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<DD>"
       by 
         ( 
           cs_concl 
             cs_simp: slicing_commute[symmetric] 
             cs_intro: dg_cs_intros slicing_intros
         )
     show "vfsequence (smcf_const \<CC> \<DD> a f)" unfolding dghm_const_def by simp
     show "vcard (smcf_const \<CC> \<DD> a f) = 4\<^sub>\<nat>"
       unfolding dghm_const_def by (simp add: nat_omega_simps)
     fix g' b c f' a' assume "g' : b \<mapsto>\<^bsub>\<CC>\<^esub> c" "f' : a' \<mapsto>\<^bsub>\<CC>\<^esub> b"
     with assms(1-3) show "smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr> =
       smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>g'\<rparr> \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> smcf_const \<CC> \<DD> a f\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
       by (cs_concl cs_simp: assms(4) smc_cs_simps cs_intro: smc_cs_intros)
   qed (auto simp: assms(1,2) dghm_const_components)
 qed 
 
 lemma smcf_const_is_semifunctor'[smc_cs_intros]: 
   assumes "semicategory \<alpha> \<CC>" 
     and "semicategory \<alpha> \<DD>" 
     and "f : a \<mapsto>\<^bsub>\<DD>\<^esub> a"
     and "f \<circ>\<^sub>A\<^bsub>\<DD>\<^esub> f = f"
     and "\<AA> = \<CC>"
     and "\<BB> = \<DD>"
   shows "smcf_const \<CC> \<DD> a f : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms(1-4) unfolding assms(5,6) by (rule smcf_const_is_semifunctor)
 
 
+subsubsection\<open>Further properties\<close>
+
+lemma (in is_semifunctor) smcf_smcf_comp_smcf_const[smc_cs_simps]:
+  assumes "semicategory \<alpha> \<CC>" and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> a" and "f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f"
+  shows "smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_const \<AA> \<CC> a f"
+proof(rule smcf_dghm_eqI)
+  interpret \<CC>: semicategory \<alpha> \<CC> by (rule assms(1))
+  from assms(2) show "smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_simp: smc_cs_simps assms(3) cs_intro: smc_cs_intros)
+  from assms(2) show "smcf_const \<AA> \<CC> a f : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (cs_concl cs_simp: smc_cs_simps assms(3) cs_intro: smc_cs_intros)
+  from is_dghm.dghm_dghm_comp_dghm_const[
+    OF smcf_is_dghm \<CC>.smc_digraph, unfolded slicing_simps, OF assms(2)
+    ]
+  show "smcf_dghm (smcf_const \<BB> \<CC> a f \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) = smcf_dghm (smcf_const \<AA> \<CC> a f)"
+    by (cs_prems cs_simp: slicing_simps slicing_commute)
+qed simp_all
+
+lemmas [smc_cs_simps] = is_semifunctor.smcf_smcf_comp_smcf_const
+
+
 
 subsection\<open>Faithful semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_ft_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes ft_smcf_is_ft_dghm: 
     "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
 
 syntax "_is_ft_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_ft_semifunctor) ft_smcf_is_ft_dghm'[slicing_intros]:
   assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule ft_smcf_is_ft_dghm)
 
 lemmas [slicing_intros] = is_ft_semifunctor.ft_smcf_is_ft_dghm'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_ft_semifunctor) is_ft_semifunctor_axioms'[smcf_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_ft_semifunctor_axioms)
 
 mk_ide rf is_ft_semifunctor_def[unfolded is_ft_semifunctor_axioms_def]
   |intro is_ft_semifunctorI|
   |dest is_ft_semifunctorD[dest]|
   |elim is_ft_semifunctorE[elim]|
 
 lemmas [smcf_cs_intros] = is_ft_semifunctorD(1)
 
 lemma is_ft_semifunctorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_ft_semifunctorI)
     (
       simp_all add: 
         assms(1) 
         is_ft_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
     )
 
 lemma is_ft_semifunctorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   by 
     (
       simp_all add: 
         is_ft_semifunctorD[OF assms(1)] 
         is_ft_dghmD(2)[
           OF is_ft_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_ft_semifunctorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> v11 (\<FF>\<lparr>ArrMap\<rparr> \<restriction>\<^sup>l\<^sub>\<circ> Hom \<AA> a b)"
   using assms by (simp_all add: is_ft_semifunctorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_ft_semifunctor
 begin
 
 interpretation dghm: is_ft_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
   by (rule ft_smcf_is_ft_dghm) 
 
 lemmas_with [unfolded slicing_simps]:
   ft_smcf_v11_on_Hom = dghm.ft_dghm_v11_on_Hom
 
 end
 
 
 subsubsection\<open>Opposite faithful semifunctor\<close>
 
 lemma (in is_ft_semifunctor) is_ft_semifunctor_op: 
   "op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> op_smc \<BB>"   
   by 
     (
       rule is_ft_semifunctorI, 
       unfold smc_op_simps slicing_simps slicing_commute[symmetric]
     )
     (
       simp_all add: 
         is_semifunctor_op is_ft_dghm.ft_dghm_op_dghm_is_ft_dghm 
         ft_smcf_is_ft_dghm
     )
 
 lemma (in is_ft_semifunctor) is_ft_semifunctor_op'[smc_op_intros]: 
   assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
   shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_ft_semifunctor_op)
 
 lemmas is_ft_semifunctor_op[smc_op_intros] = 
   is_ft_semifunctor.is_ft_semifunctor_op'
 
 
 subsubsection\<open>
 The composition of faithful semifunctors is a faithful semifunctor
 \<close>
 
 lemma smcf_comp_is_ft_semifunctor[smcf_cs_intros]:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_ft_semifunctorI)
   interpret \<GG>: is_ft_semifunctor \<alpha> \<BB> \<CC> \<GG> by (simp add: assms(1))
   interpret \<FF>: is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF> by (simp add: assms(2))
   from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show \<GG>\<FF>: 
     "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (auto intro: smc_cs_intros)
   then interpret is_semifunctor \<alpha> \<AA> \<CC> \<open>\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>\<close> .
   show "smcf_dghm (\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
     unfolding slicing_simps slicing_commute[symmetric] 
     by (auto intro: dghm_cs_intros slicing_intros)
 qed
 
 
 
 subsection\<open>Full semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_fl_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes fl_smcf_is_fl_dghm:
     "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
 
 syntax "_is_fl_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_fl_semifunctor) fl_smcf_is_fl_dghm'[slicing_intros]:
   assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule fl_smcf_is_fl_dghm)
 
 lemmas [slicing_intros] = is_fl_semifunctor.fl_smcf_is_fl_dghm'
 
 
 text\<open>Rules.\<close>
 
 mk_ide rf is_fl_semifunctor_def[unfolded is_fl_semifunctor_axioms_def]
   |intro is_fl_semifunctorI|
   |dest is_fl_semifunctorD[dest]|
   |elim is_fl_semifunctorE[elim]|
 
 lemmas [smcf_cs_intros] = is_fl_semifunctorD(1)
 
 lemma is_fl_semifunctorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow>
       \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_fl_semifunctorI)
     (
       simp_all add: 
         assms(1) 
         is_fl_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
     )
 
 lemma is_fl_semifunctorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> 
       \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   by 
     (
       simp_all add: 
         is_fl_semifunctorD[OF assms(1)] 
         is_fl_dghmD(2)[
           OF is_fl_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_fl_semifunctorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<And>a b. \<lbrakk> a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>; b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<rbrakk> \<Longrightarrow> 
       \<FF>\<lparr>ArrMap\<rparr> `\<^sub>\<circ> (Hom \<AA> a b) = Hom \<BB> (\<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>) (\<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   using assms by (simp_all add: is_fl_semifunctorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_fl_semifunctor
 begin
 
 interpretation dghm: is_fl_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
   by (rule fl_smcf_is_fl_dghm) 
 
 lemmas_with [unfolded slicing_simps]:
   fl_smcf_surj_on_Hom = dghm.fl_dghm_surj_on_Hom
 
 end
 
 
 subsubsection\<open>Opposite full semifunctor\<close>
 
 lemma (in is_fl_semifunctor) is_fl_semifunctor_op: 
   "op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> op_smc \<BB>"    
   by 
     (
       rule is_fl_semifunctorI, 
       unfold smc_op_simps slicing_simps slicing_commute[symmetric]
     )
     (
       simp_all add: 
         is_semifunctor_op 
         is_fl_dghm.fl_dghm_op_dghm_is_fl_dghm 
         fl_smcf_is_fl_dghm
     )
 
 lemma (in is_fl_semifunctor) is_fl_semifunctor_op'[smc_op_intros]: 
   assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
   shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_fl_semifunctor_op)
 
 lemmas is_fl_semifunctor_op[smc_op_intros] = 
   is_fl_semifunctor.is_fl_semifunctor_op
 
 
 subsubsection\<open>The composition of full semifunctors is a full semifunctor\<close>
 
 lemma smcf_comp_is_fl_semifunctor[smcf_cs_intros]:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_fl_semifunctorI)
   interpret \<FF>: is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF> using assms(2) by simp
   interpret \<GG>: is_fl_semifunctor \<alpha> \<BB> \<CC> \<GG> using assms(1) by simp
   from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show
     "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     by (auto intro: smc_cs_intros)
   show "smcf_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>u\<^sub>l\<^sub>l\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
     unfolding slicing_commute[symmetric] 
     by (auto intro: dghm_cs_intros slicing_intros)
 qed 
 
 
 
 subsection\<open>Fully faithful semifunctor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale is_ff_semifunctor = 
   is_ft_semifunctor \<alpha> \<AA> \<BB> \<FF> + is_fl_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF>
 
 syntax "_is_ff_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_ff_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 
 text\<open>Rules.\<close>
 
 mk_ide rf is_ff_semifunctor_def
   |intro is_ff_semifunctorI|
   |dest is_ff_semifunctorD[dest]|
   |elim is_ff_semifunctorE[elim]|
 
 lemmas [smcf_cs_intros] = is_ff_semifunctorD
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_ff_semifunctor) ff_smcf_is_ff_dghm:
   "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
   by (rule is_ff_dghmI) (auto intro: slicing_intros)
 
 lemma (in is_ff_semifunctor) ff_smcf_is_ff_dghm'[slicing_intros]:
   assumes "\<AA>' = smc_dg \<AA>" and "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule ff_smcf_is_ff_dghm)
 
 lemmas [slicing_intros] = is_ff_semifunctor.ff_smcf_is_ff_dghm'
 
 
 subsubsection\<open>Opposite fully faithful semifunctor\<close>
 
 lemma (in is_ff_semifunctor) is_ff_semifunctor_op: 
   "op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> op_smc \<BB>"    
   by (rule is_ff_semifunctorI) 
     (auto simp: is_fl_semifunctor_op is_ft_semifunctor_op)
 
 lemma (in is_ff_semifunctor) is_ff_semifunctor_op'[smc_op_intros]: 
   assumes "\<AA>' = op_smc \<AA>" and "\<BB>' = op_smc \<BB>"
   shows "op_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule is_ff_semifunctor_op)
 
 lemmas is_ff_semifunctor_op[smc_op_intros] = 
   is_ff_semifunctor.is_ff_semifunctor_op'
 
 
 subsubsection\<open>
 The composition of fully faithful semifunctors is a fully faithful
 semifunctor
 \<close>
 
 lemma smcf_comp_is_ff_semifunctor[smcf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<CC>"
   using assms 
   by (intro is_ff_semifunctorI, elim is_ff_semifunctorE) 
     (auto intro: smcf_cs_intros)
 
 
 
 subsection\<open>Isomorphism of semicategories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_iso_semifunctor = is_semifunctor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> + 
   assumes iso_smcf_is_iso_dghm: 
     "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
 
 syntax "_is_iso_semifunctor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<index> _)\<close> [51, 51, 51] 51)
 translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF>"
 
 lemma (in is_iso_semifunctor) iso_smcf_is_iso_dghm'[slicing_intros]:
   assumes "\<AA>' = smc_dg \<AA>" "\<BB>' = smc_dg \<BB>"
   shows "smcf_dghm \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule iso_smcf_is_iso_dghm)
 
 lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_iso_semifunctor) is_iso_semifunctor_axioms'[smcf_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
   shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>'\<^esub> \<BB>'"
   unfolding assms by (rule is_iso_semifunctor_axioms)
 
 mk_ide rf is_iso_semifunctor_def[unfolded is_iso_semifunctor_axioms_def]
   |intro is_iso_semifunctorI|
   |dest is_iso_semifunctorD[dest]|
   |elim is_iso_semifunctorE[elim]|
 
 lemma is_iso_semifunctorI':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms
   by (intro is_iso_semifunctorI)
     (
       simp_all add: 
         assms(1) 
         is_iso_dghmI[OF is_semifunctorD(6)[OF assms(1)], unfolded slicing_simps]
     )
 
 lemma is_iso_semifunctorD':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   by 
     (
       simp_all add: 
         is_iso_semifunctorD[OF assms(1)] 
         is_iso_dghmD(2-5)[
           OF is_iso_semifunctorD(2)[OF assms(1)], unfolded slicing_simps
           ]
     )
 
 lemma is_iso_semifunctorE':
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "v11 (\<FF>\<lparr>ObjMap\<rparr>)"
     and "v11 (\<FF>\<lparr>ArrMap\<rparr>)"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
     and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   using assms by (simp_all add: is_iso_semifunctorD')
 
 
 text\<open>Elementary properties.\<close>
 
 context is_iso_semifunctor
 begin
 
 interpretation dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
   by (rule iso_smcf_is_iso_dghm) 
 
 lemmas_with [unfolded slicing_simps]:
   iso_smcf_ObjMap_vrange[smcf_cs_simps] = dghm.iso_dghm_ObjMap_vrange
   and iso_smcf_ArrMap_vrange[smcf_cs_simps] = dghm.iso_dghm_ArrMap_vrange
 
 sublocale ObjMap: v11 \<open>\<FF>\<lparr>ObjMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
   by (rule dghm.iso_dghm_ObjMap_v11[unfolded slicing_simps]) 
     (simp_all add: smc_cs_simps smcf_cs_simps)
 
 sublocale ArrMap: v11 \<open>\<FF>\<lparr>ArrMap\<rparr>\<close>
   rewrites "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" and "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
   by (rule dghm.iso_dghm_ArrMap_v11[unfolded slicing_simps])
     (simp_all add: smc_cs_simps smcf_cs_simps)
 
 lemmas_with [unfolded slicing_simps]:
   iso_smcf_Obj_HomDom_if_Obj_HomCod[elim] = 
     dghm.iso_dghm_Obj_HomDom_if_Obj_HomCod
   and iso_smcf_Arr_HomDom_if_Arr_HomCod[elim] = 
     dghm.iso_dghm_Arr_HomDom_if_Arr_HomCod
   and iso_smcf_ObjMap_eqE[elim] = dghm.iso_dghm_ObjMap_eqE
   and iso_smcf_ArrMap_eqE[elim] = dghm.iso_dghm_ArrMap_eqE
 
 end
 
 sublocale is_iso_semifunctor \<subseteq> is_ff_semifunctor 
 proof-
   interpret dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
     by (rule iso_smcf_is_iso_dghm) 
   show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>f\<^bsub>\<alpha>\<^esub> \<BB>" by unfold_locales
 qed
 
 lemmas (in is_iso_semifunctor) iso_smcf_is_ff_semifunctor = 
   is_ff_semifunctor_axioms
 
 lemmas [smcf_cs_intros] = is_iso_semifunctor.iso_smcf_is_ff_semifunctor
 
 
 subsubsection\<open>Opposite isomorphism of semicategories\<close>
 
 lemma (in is_iso_semifunctor) is_iso_semifunctor_op: 
   "op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> op_smc \<BB>"   
   by 
     (
       rule is_iso_semifunctorI, 
       unfold smc_op_simps slicing_simps slicing_commute[symmetric]
     )
     (
       simp_all add: 
         is_semifunctor_op is_iso_dghm.is_iso_dghm_op iso_smcf_is_iso_dghm
     )
 
 lemmas is_iso_semifunctor_op[smc_op_intros] =
   is_iso_semifunctor.is_iso_semifunctor_op
 
 
 subsubsection\<open>
 The composition of isomorphisms of semicategories is an isomorphism of 
 semicategories
 \<close>
 
 lemma smcf_comp_is_iso_semifunctor[smcf_cs_intros]:
   assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_iso_semifunctorI)
   interpret \<FF>: is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF> using assms by auto
   interpret \<GG>: is_iso_semifunctor \<alpha> \<BB> \<CC> \<GG> using assms by auto
   from \<FF>.is_semifunctor_axioms \<GG>.is_semifunctor_axioms show 
     "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     by (auto intro: smcf_cs_intros)
   show "smcf_dghm (\<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<FF>) : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<CC>"
     by 
       (
         auto 
           intro: dghm_cs_intros slicing_intros 
           simp: slicing_commute[symmetric]
       )
 qed
 
 
 
 subsection\<open>Inverse semifunctor\<close>
 
 abbreviation (input) inv_smcf :: "V \<Rightarrow> V"
   where "inv_smcf \<equiv> inv_dghm"
 
 lemmas [smc_cs_simps] = inv_dghm_components(3,4)
 
 
 text\<open>Slicing.\<close>
 
 lemma dghm_inv_smcf[slicing_commute]: 
   "inv_dghm (smcf_dghm \<FF>) = smcf_dghm (inv_smcf \<FF>)"
   unfolding smcf_dghm_def inv_dghm_def dghm_field_simps 
   by (simp_all add: nat_omega_simps)
 
 context is_iso_semifunctor
 begin
 
 interpretation dghm: is_iso_dghm \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close>
   by (rule iso_smcf_is_iso_dghm) 
 
 lemmas_with [unfolded slicing_simps slicing_commute]:
   inv_smcf_ObjMap_v11 = dghm.inv_dghm_ObjMap_v11
   and inv_smcf_ObjMap_vdomain = dghm.inv_dghm_ObjMap_vdomain
   and inv_smcf_ObjMap_app = dghm.inv_dghm_ObjMap_app
   and inv_smcf_ObjMap_vrange = dghm.inv_dghm_ObjMap_vrange
   and inv_smcf_ArrMap_v11 = dghm.inv_dghm_ArrMap_v11
   and inv_smcf_ArrMap_vdomain = dghm.inv_dghm_ArrMap_vdomain
   and inv_smcf_ArrMap_app = dghm.inv_dghm_ArrMap_app
   and inv_smcf_ArrMap_vrange = dghm.inv_dghm_ArrMap_vrange
   and iso_smcf_ObjMap_inv_smcf_ObjMap_app =
     dghm.iso_dghm_ObjMap_inv_dghm_ObjMap_app
   and iso_smcf_ArrMap_inv_smcf_ArrMap_app = 
     dghm.iso_dghm_ArrMap_inv_dghm_ArrMap_app
   and iso_smcf_HomDom_is_arr_conv = dghm.iso_dghm_HomDom_is_arr_conv
   and iso_smcf_HomCod_is_arr_conv = dghm.iso_dghm_HomCod_is_arr_conv
 
 end
 
 lemmas [smcf_cs_intros] = 
   is_iso_semifunctor.inv_smcf_ObjMap_v11
   is_iso_semifunctor.inv_smcf_ArrMap_v11
 
 lemmas [smcf_cs_simps] = 
   is_iso_semifunctor.inv_smcf_ObjMap_vdomain
   is_iso_semifunctor.inv_smcf_ObjMap_app
   is_iso_semifunctor.inv_smcf_ObjMap_vrange
   is_iso_semifunctor.inv_smcf_ArrMap_vdomain
   is_iso_semifunctor.inv_smcf_ArrMap_app
   is_iso_semifunctor.inv_smcf_ArrMap_vrange
   is_iso_semifunctor.iso_smcf_ObjMap_inv_smcf_ObjMap_app
   is_iso_semifunctor.iso_smcf_ArrMap_inv_smcf_ArrMap_app
 
 
 
 subsection\<open>
 An isomorphism of semicategories is an isomorphism in the category \<open>SemiCAT\<close>
 \<close>
 
 lemma is_arr_isomorphism_is_iso_semifunctor:
   \<comment>\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
     and "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
     and "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> = smcf_id \<BB>"
   shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 proof-
   interpret \<FF>: is_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
   interpret \<GG>: is_semifunctor \<alpha> \<BB> \<AA> \<GG> by (rule assms(2))
   show ?thesis
   proof(rule is_iso_semifunctorI)
     have dg_\<GG>\<FF>\<AA>: "smcf_dghm \<GG> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<FF> = dghm_id (smc_dg \<AA>)"
       by (simp add: assms(3) smcf_dghm_smcf_id smcf_dghm_smcf_comp)
     have dg_\<FF>\<GG>\<BB>: "smcf_dghm \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M smcf_dghm \<GG> = dghm_id (smc_dg \<BB>)"
       by (simp add: assms(4) smcf_dghm_smcf_id smcf_dghm_smcf_comp)
     from \<FF>.smcf_is_dghm \<GG>.smcf_is_dghm dg_\<GG>\<FF>\<AA> dg_\<FF>\<GG>\<BB> show 
       "smcf_dghm \<FF> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
       by (rule is_arr_isomorphism_is_iso_dghm)
   qed (simp add: \<FF>.is_semifunctor_axioms)
 qed
 
 lemma is_iso_semifunctor_is_arr_isomorphism:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   shows [smcf_cs_intros]: "inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
     and "inv_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
     and "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> = smcf_id \<BB>"
 proof-
 
   let ?\<GG> = \<open>inv_smcf \<FF>\<close>
 
   interpret is_iso_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
 
   note is_iso_dghm = is_iso_dghm_is_arr_isomorphism[OF iso_smcf_is_iso_dghm]
 
   show \<GG>: "?\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"
   proof
     (
       intro is_iso_semifunctorI is_semifunctorI; 
       (unfold slicing_commute[symmetric])?
     )
     show "vfsequence (inv_smcf \<FF>)" unfolding inv_dghm_def by simp
     show "vcard (inv_smcf \<FF>) = 4\<^sub>\<nat>"
       unfolding inv_dghm_def by (simp add: nat_omega_simps)
     show inv_iso_dghm_\<FF>: 
       "inv_dghm (smcf_dghm \<FF>) : smc_dg \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> smc_dg \<AA>"
       by (rule is_iso_dghm(1))
     show inv_dghm_\<FF>: "inv_dghm (smcf_dghm \<FF>) : smc_dg \<BB> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<AA>"
       by (rule is_iso_dghmD(1)[OF inv_iso_dghm_\<FF>])
     fix b c g a f assume prems: "g : b \<mapsto>\<^bsub>\<BB>\<^esub> c" "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
     note is_arr_inv = is_dghm.dghm_ArrMap_is_arr[
         OF inv_dghm_\<FF>, unfolded slicing_simps slicing_commute
         ]
     from prems is_arr_inv[OF prems(1)] is_arr_inv[OF prems(2)] show 
       "inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<BB>\<^esub> f\<rparr> =
         inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> inv_smcf \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
        unfolding inv_dghm_components
        by (intro v11.v11_vconverse_app)
          (
            cs_concl 
             cs_intro: smc_cs_intros V_cs_intros
             cs_simp: V_cs_simps smc_cs_simps
          )+
   qed (auto simp: smc_cs_simps intro: smc_cs_intros)
 
   show "?\<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> = smcf_id \<AA>"
   proof(rule smcf_eqI, unfold dghm_comp_components inv_dghm_components)
     from \<GG> is_semifunctor_axioms show "inv_smcf \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (blast intro: smc_cs_intros)
   qed
     (
       simp_all add: 
         HomDom.smc_smcf_id_is_semifunctor
         ObjMap.v11_vcomp_vconverse 
         ArrMap.v11_vcomp_vconverse 
         dghm_id_components
     )
 
   show "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> = smcf_id \<BB>"
   proof(rule smcf_eqI, unfold dghm_comp_components inv_dghm_components)
     from \<GG> is_semifunctor_axioms show "\<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
       by (blast intro: smc_cs_intros)
   qed 
     (
       simp_all add: 
         HomCod.smc_smcf_id_is_semifunctor
         ObjMap.v11_vcomp_vconverse' 
         ArrMap.v11_vcomp_vconverse' 
         dghm_id_components
     )
 
 qed
 
 
 subsubsection\<open>An identity semifunctor is an isomorphism of semicategories\<close>
 
 lemma (in semicategory) smc_smcf_id_is_iso_semifunctor: 
   "smcf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<CC>"
   by (rule is_iso_semifunctorI, unfold slicing_simps slicing_commute[symmetric])
     (
       simp_all add: 
         smc_smcf_id_is_semifunctor digraph.dg_dghm_id_is_iso_dghm smc_digraph
     )
 
 lemma (in semicategory) smc_smcf_id_is_iso_semifunctor'[smcf_cs_intros]: 
   assumes "\<AA>' = \<CC>" and "\<BB>' = \<CC>"
   shows "smcf_id \<CC> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>'"
   unfolding assms by (rule smc_smcf_id_is_iso_semifunctor)
 
 lemmas [smcf_cs_intros] = semicategory.smc_smcf_id_is_iso_semifunctor'
 
 
 
 subsection\<open>Isomorphic semicategories\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter I-3 in \cite{mac_lane_categories_2010}).\<close>
 
 locale iso_semicategory = L: semicategory \<alpha> \<AA> + R: semicategory \<alpha> \<BB> 
   for \<alpha> \<AA> \<BB> +
   assumes iso_smc_is_iso_semifunctor: "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
 
 notation iso_semicategory (infixl "\<approx>\<^sub>S\<^sub>M\<^sub>C\<index>" 50)
 
 
 text\<open>Rules.\<close>
 
 lemma iso_semicategoryI:
   assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms 
   unfolding iso_semicategory_def iso_semicategory_axioms_def 
   by blast
 
 lemma iso_semicategoryD[dest]:
   assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<exists>\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
   using assms 
   unfolding iso_semicategory_def iso_semicategory_axioms_def 
   by simp_all
 
 lemma iso_semicategoryE[elim]:
   assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   obtains \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
   using assms by auto
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in iso_semicategory) iso_smc_iso_digraph: "smc_dg \<AA> \<approx>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
   using iso_smc_is_iso_semifunctor 
   by (auto intro: slicing_intros iso_digraphI)
 
 
 subsubsection\<open>A semicategory isomorphism is an equivalence relation\<close>
 
 lemma iso_semicategory_refl: 
   assumes "semicategory \<alpha> \<AA>" 
   shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof(rule iso_semicategoryI[of _  _ _ \<open>smcf_id \<AA>\<close>])
   interpret semicategory \<alpha> \<AA> by (rule assms)
   show "smcf_id \<AA> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>"  
     by (simp add: smc_smcf_id_is_iso_semifunctor)
 qed
 
 lemma iso_semicategory_sym[sym]:
   assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" 
   shows "\<BB> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   interpret iso_semicategory \<alpha> \<AA> \<BB> by (rule assms)
   from iso_smc_is_iso_semifunctor obtain \<FF> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>" 
     by clarsimp
   then have "inv_smcf \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<AA>" 
     by (simp add: is_iso_semifunctor_is_arr_isomorphism(1))
   then show ?thesis by (auto intro: iso_semicategoryI)
 qed
 
 lemma iso_semicategory_trans[trans]:
   assumes "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "\<BB> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
   shows "\<AA> \<approx>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-  
   interpret L: iso_semicategory \<alpha> \<AA> \<BB> by (rule assms(1))
   interpret R: iso_semicategory \<alpha> \<BB> \<CC> by (rule assms(2))
   from L.iso_smc_is_iso_semifunctor R.iso_smc_is_iso_semifunctor show ?thesis
     by (auto intro: iso_semicategoryI smcf_cs_intros)
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Universal_Constructions/ROOT b/thys/CZH_Universal_Constructions/ROOT
--- a/thys/CZH_Universal_Constructions/ROOT
+++ b/thys/CZH_Universal_Constructions/ROOT
@@ -1,15 +1,15 @@
 chapter AFP
 
 session CZH_Universal_Constructions (AFP) = CZH_Elementary_Categories +
-  options [timeout = 7200]
+  options [timeout = 14400]
   directories
     czh_ucategories
   theories
     CZH_UCAT_Conclusions
   document_files
     "iman.sty"
     "extra.sty"
     "isar.sty"
     "style.sty"
     "root.tex"
     "root.bib"
diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Kan.thy
@@ -1,3067 +1,3308 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Simple Kan extensions\<close>
 theory CZH_UCAT_Kan
   imports 
     CZH_Elementary_Categories.CZH_ECAT_Comma
     CZH_UCAT_Limit
     CZH_UCAT_Adjoints
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems ua_field_simps
 
 definition UObj :: V where [ua_field_simps]: "UObj = 0"
 definition UArr :: V where [ua_field_simps]: "UArr = 1\<^sub>\<nat>"
 
 named_theorems cat_Kan_cs_simps
 named_theorems cat_Kan_cs_intros
 
 
 
 subsection\<open>Kan extension\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Chapter X-3 in \cite{mac_lane_categories_2010}.\<close>
 
 locale is_cat_rKe = 
   AG: is_functor \<alpha> \<BB> \<CC> \<KK> + 
   Ran: is_functor \<alpha> \<CC> \<AA> \<GG> +
   ntcf_rKe: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon>
   for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> +
   assumes cat_rKe_ua_fo:
     "universal_arrow_fo
       (exp_cat_cf \<alpha> \<AA> \<KK>)
       (cf_map \<TT>)
       (cf_map \<GG>)
       (ntcf_arrow \<epsilon>)"
 
 syntax "_is_cat_rKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> [51, 51, 51, 51, 51, 51, 51] 51)
 translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons> 
   "CONST is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>"
 
 locale is_cat_lKe =
   AG: is_functor \<alpha> \<BB> \<CC> \<KK> +
   Lan: is_functor \<alpha> \<CC> \<AA> \<FF> +
   ntcf_lKe: is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta>
   for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> +
   assumes cat_lKe_ua_fo:
     "universal_arrow_fo
       (exp_cat_cf \<alpha> (op_cat \<AA>) (op_cf \<KK>))
       (cf_map \<TT>)
       (cf_map \<FF>)
       (ntcf_arrow (op_ntcf \<eta>))"
 
 syntax "_is_cat_lKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> [51, 51, 51, 51, 51, 51, 51] 51)
 translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons> 
   "CONST is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<GG>' = \<GG>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
   shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_rKe_axioms)
 
 mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
   |intro is_cat_rKeI|
   |dest is_cat_rKeD[dest]|
   |elim is_cat_rKeE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
 
 lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<FF>' = \<FF>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
   shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_lKe_axioms)
 
 mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
   |intro is_cat_lKeI|
   |dest is_cat_lKeD[dest]|
   |elim is_cat_lKeE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_rKe) is_cat_lKe_op:
   "op_ntcf \<epsilon> :
     op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
   by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<GG>' = op_cf \<GG>"
     and "\<KK>' = op_cf \<KK>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<epsilon> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_lKe_op)
 
 lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'
 
 lemma (in is_cat_lKe) is_cat_rKe_op:
   "op_ntcf \<eta> :
     op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
   by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<FF>' = op_cf \<FF>"
     and "\<KK>' = op_cf \<KK>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<eta> : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_rKe_op)
 
 lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "exp_cat_cf \<alpha> \<AA> \<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
   by 
     ( 
       rule exp_cat_cf_is_tiny_functor[
         OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
         ]
     )
 
 lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "exp_cat_cf \<alpha> \<AA> \<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
   by 
     ( 
       rule exp_cat_cf_is_tiny_functor[
         OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
         ]
     )
 
 
 subsubsection\<open>Universal property\<close>
 
 
 text\<open>
 See Chapter X-3 in \cite{mac_lane_categories_2010} and 
 \cite{noauthor_wikipedia_2001}\footnote{
 \url{https://en.wikipedia.org/wiki/Kan_extension}
 }.
 \<close>
 
 lemma is_cat_rKeI':
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<And>\<GG>' \<epsilon>'.
       \<lbrakk> \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>; \<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<rbrakk> \<Longrightarrow>
         \<exists>!\<sigma>. \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)" 
   shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
 proof-
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<GG>: is_functor \<alpha> \<CC> \<AA> \<GG> by (rule assms(2))
   interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon> by (rule assms(3))
   let ?\<AA>\<KK> = \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
     and ?\<TT> = \<open>cf_map \<TT>\<close>
     and ?\<GG> = \<open>cf_map \<GG>\<close>
   show ?thesis
   proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
     define \<beta> where "\<beta> = \<alpha> + \<omega>"
     have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
       by (simp_all add: \<beta>_def \<KK>.\<Z>_Limit_\<alpha>\<omega> \<KK>.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<KK>.\<Z>_\<alpha>_\<alpha>\<omega>)
     then interpret \<beta>: \<Z> \<beta> by simp 
     show "?\<AA>\<KK> : cat_FUNCT \<alpha> \<CC> \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<BB> \<AA>"
       by 
         ( 
           cs_concl cs_intro: 
             cat_small_cs_intros 
             exp_cat_cf_is_tiny_functor[
               OF \<beta>.\<Z>_axioms \<alpha>\<beta> \<GG>.HomCod.category_axioms assms(1)
               ]
         )
     from \<alpha>\<beta> assms(2) show "cf_map \<GG> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
       unfolding cat_FUNCT_components
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
     from assms(1-3) show "ntcf_arrow \<epsilon> :
       ?\<AA>\<KK>\<lparr>ObjMap\<rparr>\<lparr>?\<GG>\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
       by 
         (
           cs_concl 
             cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) 
             cs_intro: cat_FUNCT_cs_intros
         )
     fix \<FF>' \<epsilon>' assume prems: 
       "\<FF>' \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
       "\<epsilon>' : ?\<AA>\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<FF>'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
     from prems(1) have "\<FF>' \<in>\<^sub>\<circ> cf_maps \<alpha> \<CC> \<AA>"  
       unfolding cat_FUNCT_components(1) by simp
     then obtain \<FF> where \<FF>'_def: "\<FF>' = cf_map \<FF>" and \<FF>: "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" 
       by clarsimp
     note \<epsilon>' = cat_FUNCT_is_arrD[OF prems(2)]
     from \<epsilon>'(1) \<FF> have \<epsilon>'_is_ntcf: 
       "ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' : \<FF> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by 
         ( 
           cs_prems 
             cs_simp: \<FF>'_def cat_Kan_cs_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     from assms(4)[OF \<FF> \<epsilon>'_is_ntcf] obtain \<sigma>
       where \<sigma>: "\<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" 
         and \<epsilon>'_def': "ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
         and unique_\<sigma>: "\<And>\<sigma>'. 
           \<lbrakk> 
             \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
             ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) 
           \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
       by metis
     show "\<exists>!f'.
       f' : \<FF>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG> \<and>
       \<epsilon>' = umap_fo ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) \<FF>'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
     proof(intro ex1I conjI; (elim conjE)?, unfold \<FF>'_def)
       from \<sigma> show "ntcf_arrow \<sigma> : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>"
         by (cs_concl cs_intro: cat_FUNCT_cs_intros)
       from \<alpha>\<beta> assms(1-3) \<sigma> \<epsilon>'(1) show 
         "\<epsilon>' = umap_fo
           ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) (cf_map \<FF>)\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow \<sigma>\<rparr>"
         by (subst \<epsilon>')
           (
             cs_concl 
               cs_simp: 
                 \<epsilon>'_def'[symmetric] 
                 cat_cs_simps 
                 cat_FUNCT_cs_simps 
                 cat_Kan_cs_simps 
               cs_intro: 
                 cat_small_cs_intros 
                 cat_cs_intros 
                 cat_Kan_cs_intros
                 cat_FUNCT_cs_intros
           )
       fix \<sigma>' assume prems:
         "\<sigma>' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>"
         "\<epsilon>' = umap_fo ?\<AA>\<KK> ?\<TT> ?\<GG> (ntcf_arrow \<epsilon>) (cf_map \<FF>)\<lparr>ArrVal\<rparr>\<lparr>\<sigma>'\<rparr>"
       note \<sigma>' = cat_FUNCT_is_arrD[OF prems(1)]
       from \<sigma>'(1) \<FF> have "ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
       moreover from prems(2) prems(1) \<alpha>\<beta> assms(1-3) this \<epsilon>'(1) have 
         "ntcf_of_ntcf_arrow \<BB> \<AA> \<epsilon>' =
           \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
         by (subst (asm) \<epsilon>'(2))
           (
             cs_prems 
               cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps 
               cs_intro: 
                 cat_Kan_cs_intros
                 cat_small_cs_intros
                 cat_cs_intros
                 cat_FUNCT_cs_intros
           )
       ultimately have \<sigma>_def: "\<sigma> = ntcf_of_ntcf_arrow \<CC> \<AA> \<sigma>'" 
         by (rule unique_\<sigma>[symmetric])
       show "\<sigma>' = ntcf_arrow \<sigma>"
         by (subst \<sigma>'(2), use nothing in \<open>subst \<sigma>_def\<close>)
           (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed
   qed
 qed
 
 lemma is_cat_lKeI':
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<And>\<FF>' \<eta>'.
       \<lbrakk> \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>; \<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<rbrakk> \<Longrightarrow>
         \<exists>!\<sigma>. \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<eta>' = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" 
   shows "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
 proof-
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<FF>: is_functor \<alpha> \<CC> \<AA> \<FF> by (rule assms(2))
   interpret \<eta>: is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta> by (rule assms(3))
   have 
     "\<exists>!\<sigma>.
       \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA> \<and>
       \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
     if "\<GG>' : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
       and "\<eta>' : \<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F op_cf \<TT> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
     for \<GG>' \<eta>'
   proof-
     interpret \<GG>': is_functor \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<GG>' by (rule that(1))
     interpret \<eta>': 
       is_ntcf \<alpha> \<open>op_cat \<BB>\<close> \<open>op_cat \<AA>\<close> \<open>\<GG>' \<circ>\<^sub>C\<^sub>F op_cf \<KK>\<close> \<open>op_cf \<TT>\<close> \<eta>'
       by (rule that(2))
     from assms(4)[
         OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
         OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
         ]
     obtain \<sigma> where \<sigma>: "\<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" 
       and op_\<eta>'_def: "op_ntcf \<eta>' = \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
       and unique_\<sigma>':
         "\<lbrakk>
           \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F op_cf \<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
           op_ntcf \<eta>' = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>
          \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
       for \<sigma>'
       by metis
     interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<FF> \<open>op_cf \<GG>'\<close> \<sigma> by (rule \<sigma>)
     show ?thesis
     proof(intro ex1I conjI; (elim conjE)?)
       show "op_ntcf \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
         by (rule \<sigma>.is_ntcf_op[unfolded cat_op_simps])
       from op_\<eta>'_def have "op_ntcf (op_ntcf \<eta>') = op_ntcf (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
         by simp
       from this \<sigma> assms(1-3) show \<eta>'_def:
         "\<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
         by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
       fix \<sigma>' assume prems:
         "\<sigma>' : \<GG>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
         "\<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
       interpret \<sigma>': is_ntcf \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<GG>' \<open>op_cf \<FF>\<close> \<sigma>' 
         by (rule prems(1))
       from prems(2) have 
         "op_ntcf \<eta>' = op_ntcf (op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>))"
         by simp
       also have "\<dots> = op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"   
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_op_intros
           )
       finally have "op_ntcf \<eta>' = op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" by simp
       from unique_\<sigma>'[OF \<sigma>'.is_ntcf_op[unfolded cat_op_simps] this] show 
         "\<sigma>' = op_ntcf \<sigma>" 
         by (auto simp: cat_op_simps)
     qed
   qed
   from 
     is_cat_rKeI'
       [
         OF \<KK>.is_functor_op \<FF>.is_functor_op \<eta>.is_ntcf_op[unfolded cat_op_simps], 
         unfolded cat_op_simps, 
         OF this
       ]
   interpret \<eta>: is_cat_rKe 
     \<alpha> 
     \<open>op_cat \<BB>\<close> 
     \<open>op_cat \<CC>\<close>
     \<open>op_cat \<AA>\<close> 
     \<open>op_cf \<KK>\<close> 
     \<open>op_cf \<TT>\<close> 
     \<open>op_cf \<FF>\<close> 
     \<open>op_ntcf \<eta>\<close>
     by simp
   show "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
     by (rule \<eta>.is_cat_lKe_op[unfolded cat_op_simps])
 qed
 
 lemma (in is_cat_rKe) cat_rKe_unique:
   assumes "\<GG>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<exists>!\<sigma>. \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)" 
 proof-
 
   interpret \<GG>': is_functor \<alpha> \<CC> \<AA> \<GG>' by (rule assms(1))
   interpret \<epsilon>': is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG>' \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon>' by (rule assms(2))
 
   let ?\<TT> = \<open>cf_map \<TT>\<close>
     and ?\<GG> = \<open>cf_map \<GG>\<close>
     and ?\<GG>' = \<open>cf_map \<GG>'\<close>
     and ?\<epsilon> = \<open>ntcf_arrow \<epsilon>\<close>
     and ?\<epsilon>' = \<open>ntcf_arrow \<epsilon>'\<close>
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def AG.\<Z>_Limit_\<alpha>\<omega> AG.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def AG.\<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp
   
   interpret \<AA>\<KK>: is_tiny_functor 
     \<beta> \<open>cat_FUNCT \<alpha> \<CC> \<AA>\<close> \<open>cat_FUNCT \<alpha> \<BB> \<AA>\<close> \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
     by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF \<beta>.\<Z>_axioms \<alpha>\<beta>])
 
   from assms(1) have \<GG>': "?\<GG>' \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<AA>\<lparr>Obj\<rparr>"
     by (cs_concl cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros)
   with assms(2) have
     "?\<epsilon>' : exp_cat_cf \<alpha> \<AA> \<KK>\<lparr>ObjMap\<rparr>\<lparr>?\<GG>'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<BB> \<AA>\<^esub> ?\<TT>"
     by 
       ( 
         cs_concl 
           cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
 
   from
     is_functor.universal_arrow_foD(3)[
       OF \<AA>\<KK>.is_functor_axioms cat_rKe_ua_fo \<GG>' this
       ]
   obtain f' where f': "f' : cf_map \<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> cf_map \<GG>"
     and \<epsilon>'_def: "?\<epsilon>' = umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
     and f'_unique: 
       "\<lbrakk> 
         f'' : ?\<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> ?\<GG>;
         ntcf_arrow \<epsilon>' = umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr> 
        \<rbrakk> \<Longrightarrow> f'' = f'"
     for f''
     by metis
   
   show ?thesis
   proof(intro ex1I conjI; (elim conjE)?)
     from \<epsilon>'_def cat_FUNCT_is_arrD(1)[OF f'] show
       "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_of_ntcf_arrow \<CC> \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
       by (subst (asm) cat_FUNCT_is_arrD(2)[OF f']) (*slow*)
         (
           cs_prems 
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
       "ntcf_of_ntcf_arrow \<CC> \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
     fix \<sigma> assume prems: 
       "\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
     interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<GG>' \<GG> \<sigma> by (rule prems(1))
     from prems(1) have \<sigma>: 
       "ntcf_arrow \<sigma> : cf_map \<GG>' \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<CC> \<AA>\<^esub> cf_map \<GG>"
       by (cs_concl cs_intro: cat_FUNCT_cs_intros)
     from prems have \<epsilon>'_def: "ntcf_arrow \<epsilon>' =
       umap_fo (exp_cat_cf \<alpha> \<AA> \<KK>) ?\<TT> ?\<GG> ?\<epsilon> ?\<GG>'\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow \<sigma>\<rparr>"
       by 
         (
           cs_concl
             cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     show "\<sigma> = ntcf_of_ntcf_arrow \<CC> \<AA> f'"
       unfolding f'_unique[OF \<sigma> \<epsilon>'_def, symmetric]
       by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
   qed
 
 qed
 
 lemma (in is_cat_lKe) cat_lKe_unique:
   assumes "\<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "\<eta>' : \<TT> \<mapsto>\<^sub>C\<^sub>F \<FF>' \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<exists>!\<sigma>. \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<eta>' = (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" 
 proof-
 
   interpret \<FF>': is_functor \<alpha> \<CC> \<AA> \<FF>' by (rule assms(1))
   interpret \<eta>': is_ntcf \<alpha> \<BB> \<AA> \<TT> \<open>\<FF>' \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<eta>' by (rule assms(2))
   interpret \<eta>: is_cat_rKe 
     \<alpha> \<open>op_cat \<BB>\<close> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<KK>\<close> \<open>op_cf \<TT>\<close> \<open>op_cf \<FF>\<close> \<open>op_ntcf \<eta>\<close>
     by (rule is_cat_rKe_op)
 
   from \<eta>.cat_rKe_unique[OF \<FF>'.is_functor_op \<eta>'.is_ntcf_op[unfolded cat_op_simps]]
   obtain \<sigma> where \<sigma>: "\<sigma> : op_cf \<FF>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
     and \<eta>'_def: "op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
     and unique_\<sigma>': "\<And>\<sigma>'.
       \<lbrakk>
         \<sigma>' : op_cf \<FF>' \<mapsto>\<^sub>C\<^sub>F op_cf \<FF> : op_cat \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>;
         op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>) 
       \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
     by metis
 
   interpret \<sigma>: is_ntcf \<alpha> \<open>op_cat \<CC>\<close> \<open>op_cat \<AA>\<close> \<open>op_cf \<FF>'\<close> \<open>op_cf \<FF>\<close> \<sigma> 
     by (rule \<sigma>)
   
   show ?thesis
   proof(intro ex1I conjI; (elim conjE)?)
     show "op_ntcf \<sigma> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (rule \<sigma>.is_ntcf_op[unfolded cat_op_simps])
     have "\<eta>' = op_ntcf (op_ntcf \<eta>')" by (cs_concl cs_simp: cat_op_simps)
     also from \<eta>'_def have "\<dots> = op_ntcf (op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>))"
       by simp
     also have "\<dots> = op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
       by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
     finally show "\<eta>' = op_ntcf \<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>" by simp
     fix \<sigma>' assume prems: 
       "\<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF>' : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       "\<eta>' = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
     interpret \<sigma>': is_ntcf \<alpha> \<CC> \<AA> \<FF> \<FF>' \<sigma>' by (rule prems(1))
     from prems(2) have "op_ntcf \<eta>' = op_ntcf (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
       by simp
     also have "\<dots> = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
       by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
     finally have "op_ntcf \<eta>' = op_ntcf \<eta> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (op_ntcf \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf \<KK>)"
       by simp
     from unique_\<sigma>'[OF \<sigma>'.is_ntcf_op this] show "\<sigma>' = op_ntcf \<sigma>"
       by (auto simp: cat_op_simps)
   qed
 
 qed
 
 
 subsubsection\<open>Further properties\<close>
 
 lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows 
     "ntcf_ua_fo \<beta> (exp_cat_cf \<alpha> \<AA> \<KK>) (cf_map \<TT>) (cf_map \<GG>) (ntcf_arrow \<epsilon>) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<CC> \<AA>(-,cf_map \<GG>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<BB> \<AA>(-,cf_map \<TT>) \<circ>\<^sub>C\<^sub>F op_cf (exp_cat_cf \<alpha> \<AA> \<KK>) :
       op_cat (cat_FUNCT \<alpha> \<CC> \<AA>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
   interpret \<AA>_\<KK>: 
     is_tiny_functor \<beta> \<open>cat_FUNCT \<alpha> \<CC> \<AA>\<close> \<open>cat_FUNCT \<alpha> \<BB> \<AA>\<close> \<open>exp_cat_cf \<alpha> \<AA> \<KK>\<close>
     by 
       (
         rule exp_cat_cf_is_tiny_functor[
           OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
           ]
       )
   show ?thesis
     by 
       (
         rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
           OF \<AA>_\<KK>.is_functor_axioms cat_rKe_ua_fo
           ]
       )
 qed
 
 lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   defines "\<AA>\<KK> \<equiv> exp_cat_cf \<alpha> (op_cat \<AA>) (op_cf \<KK>)"
     and "\<AA>\<CC> \<equiv> cat_FUNCT \<alpha> (op_cat \<CC>) (op_cat \<AA>)"
     and "\<AA>\<BB> \<equiv> cat_FUNCT \<alpha> (op_cat \<BB>) (op_cat \<AA>)"
   shows 
     "ntcf_ua_fo \<beta> \<AA>\<KK> (cf_map \<TT>) (cf_map \<FF>) (ntcf_arrow (op_ntcf \<eta>)) :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>\<CC>(-,cf_map \<FF>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>\<BB>(-,cf_map \<TT>) \<circ>\<^sub>C\<^sub>F op_cf \<AA>\<KK> :
       op_cat \<AA>\<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
   note simps = \<AA>\<CC>_def \<AA>\<BB>_def \<AA>\<KK>_def
   interpret \<AA>_\<KK>: is_tiny_functor \<beta> \<AA>\<CC> \<AA>\<BB> \<AA>\<KK>
     unfolding simps
     by
       (
         rule exp_cat_cf_is_tiny_functor[
           OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
           ]
       )
   show ?thesis
     unfolding simps
     by 
       (
         rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
           OF \<AA>_\<KK>.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
           ]
       )
 qed
 
 
 
+subsection\<open>Opposite universal arrow for Kan extensions\<close>
+
+
+subsubsection\<open>Definition and elementary properties\<close>
+
+
+text\<open>
+The following definition is merely a convenience utility for 
+the exposition of dual results associated with the formula for 
+the right Kan extension and the pointwise right Kan extension.
+\<close>
+
+definition op_ua :: "(V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
+  where "op_ua lim_Obj \<KK> c =
+    [
+      lim_Obj c\<lparr>UObj\<rparr>,
+      op_ntcf (lim_Obj c\<lparr>UArr\<rparr>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)
+    ]\<^sub>\<circ>"
+
+
+text\<open>Components.\<close>
+
+lemma op_ua_components:
+  shows [cat_op_simps]: "op_ua lim_Obj \<KK> c\<lparr>UObj\<rparr> = lim_Obj c\<lparr>UObj\<rparr>"
+    and "op_ua lim_Obj \<KK> c\<lparr>UArr\<rparr> =
+      op_ntcf (lim_Obj c\<lparr>UArr\<rparr>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)"
+  unfolding op_ua_def ua_field_simps by (simp_all add: nat_omega_simps)
+
+
+subsubsection\<open>Opposite universal arrow for Kan extensions is a limit\<close>
+
+lemma op_ua_UArr_is_cat_limit:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+    and "u : \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+  shows "op_ntcf u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c) :
+    r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) : c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
+proof-
+
+  note [cf_cs_simps] = is_iso_functor_is_arr_isomorphism(2,3)
+
+  let ?op_\<KK> = \<open>\<lambda>c. op_cf_obj_comma \<KK> c\<close>
+  let ?op_\<KK>c = \<open>?op_\<KK> c\<close>
+    and ?op_ua_UArr = \<open>op_ntcf u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf (op_cf_obj_comma \<KK> c)\<close>
+
+  interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  interpret u: is_cat_colimit \<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> r u
+    by (rule assms(4))
+
+  from \<KK>.op_cf_cf_obj_comma_proj[OF assms(3)] have
+    "op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c) =
+      c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F (?op_\<KK> c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c)"
+    by simp
+  from this assms(3) have [cat_comma_cs_simps]:
+    "op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c) \<circ>\<^sub>C\<^sub>F inv_cf (?op_\<KK> c) = c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>)"
+    by
+      (
+        cs_prems
+          cs_simp: cat_cs_simps cat_comma_cs_simps cf_cs_simps cat_op_simps 
+          cs_intro: cf_cs_intros cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  from assms(3) show "?op_ua_UArr :
+    r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) : c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
+    by
+      (
+        cs_concl
+          cs_simp:
+            cf_cs_simps cat_cs_simps cat_comma_cs_simps cat_op_simps 
+            \<KK>.op_cf_cf_obj_comma_proj[symmetric]
+          cs_intro:
+            cat_cs_intros
+            cf_cs_intros
+            cat_lim_cs_intros
+            cat_comma_cs_intros
+            cat_op_intros
+      )
+
+qed
+
+context
+  fixes lim_Obj :: "V \<Rightarrow> V" and c :: V
+begin
+
+lemmas op_ua_UArr_is_cat_limit' = op_ua_UArr_is_cat_limit
+  [
+    unfolded op_ua_components(2)[symmetric], 
+    where u=\<open>lim_Obj c\<lparr>UArr\<rparr>\<close> and r=\<open>lim_Obj c\<lparr>UObj\<rparr>\<close> and c=c,
+    folded op_ua_components(2)[where lim_Obj=lim_Obj and c=c]
+  ]
+
+end
+
+
+
 subsection\<open>The Kan extension\<close>
 
 
 text\<open>
 The following subsection is based on the statement and proof of 
 Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
-In what follows, only the right Kan extension is considered for simplicity.
 \<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition the_cf_rKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj =
     [
       (\<lambda>c\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. lim_Obj c\<lparr>UObj\<rparr>),
       (
         \<lambda>g\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f.
           f :
             lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub>
             lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<and>
           lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
             lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F 
             ntcf_const ((\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) f
       ),
       \<KK>\<lparr>HomCod\<rparr>,
       \<TT>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
 definition the_ntcf_rKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj =
     [
       (
         \<lambda>c\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
           lim_Obj (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>0, c, \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>
       ),
       the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK>,
       \<TT>,
       \<TT>\<lparr>HomDom\<rparr>,
       \<TT>\<lparr>HomCod\<rparr>
     ]\<^sub>\<circ>"
 
+definition the_cf_lKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
+  where "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj =
+    op_cf (the_cf_rKe \<alpha> (op_cf \<TT>) (op_cf \<KK>) (op_ua lim_Obj \<KK>))"
+
+definition the_ntcf_lKe :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
+  where "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj =
+    op_ntcf (the_ntcf_rKe \<alpha> (op_cf \<TT>) (op_cf \<KK>) (op_ua lim_Obj \<KK>))"
+
 
 text\<open>Components.\<close>
 
 lemma the_cf_rKe_components:
   shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ObjMap\<rparr> = 
     (\<lambda>c\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. lim_Obj c\<lparr>UObj\<rparr>)"
     and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr> =
     (
       \<lambda>g\<in>\<^sub>\<circ>\<KK>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>. THE f.
         f :
           lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<TT>\<lparr>HomCod\<rparr>\<^esub>
           lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UObj\<rparr> \<and>
         lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Dom\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
           lim_Obj (\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>)\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F 
           ntcf_const ((\<KK>\<lparr>HomCod\<rparr>\<lparr>Cod\<rparr>\<lparr>g\<rparr>) \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) f
     )"
     and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>HomDom\<rparr> = \<KK>\<lparr>HomCod\<rparr>"
     and "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>HomCod\<rparr> = \<TT>\<lparr>HomCod\<rparr>"
   unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 lemma the_ntcf_rKe_components:
   shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTMap\<rparr> =
       (
         \<lambda>c\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>.
           lim_Obj (\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>0, c, \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>
       )"
     and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDom\<rparr> = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK>"
     and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTCod\<rparr> = \<TT>"
     and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDGDom\<rparr> = \<TT>\<lparr>HomDom\<rparr>"
     and "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>NTDGCod\<rparr> = \<TT>\<lparr>HomCod\<rparr>"
   unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas the_cf_rKe_components' = the_cf_rKe_components[
     where \<KK>=\<KK> and \<TT>=\<TT> and \<alpha>=\<alpha>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod
     ]
 
 lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)
 
 lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
     where \<KK>=\<KK> and \<TT>=\<TT> and \<alpha>=\<alpha>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod \<TT>.cf_HomDom
     ]
 
 lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)
 
 end
 
 
 subsubsection\<open>Functor: object map\<close>
 
 mk_VLambda the_cf_rKe_components(1)
   |vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 
 mk_VLambda the_cf_rKe_components'(1)[OF \<KK> \<TT>]
   |vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
   |app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
 
 lemma the_cf_rKe_ObjMap_vrange: 
   assumes "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UObj\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<R>\<^sub>\<circ> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   unfolding the_cf_rKe_components'[OF \<KK> \<TT>]
   by (intro vrange_VLambda_vsubset assms)
 
 end
 
 
 subsubsection\<open>Functor: arrow map\<close>
 
 mk_VLambda the_cf_rKe_components(2)
   |vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<BB> \<CC> \<KK>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 
 mk_VLambda the_cf_rKe_components(2)[where \<alpha>=\<alpha> and \<KK>=\<KK>, unfolded \<KK>.cf_HomCod]
   |vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]|
 
 context 
   fixes \<AA> \<TT> c c' g
   assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and g: "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
 begin
 
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemma g': "g \<in>\<^sub>\<circ> \<CC>\<lparr>Arr\<rparr>" using g by auto
 
 mk_VLambda the_cf_rKe_components(2)[
     where \<alpha>=\<alpha> and \<KK>=\<KK> and \<TT>=\<TT>, unfolded \<KK>.cf_HomCod \<TT>.cf_HomCod
     ]
   |app the_cf_rKe_ArrMap_app_impl'|
 
 lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
     OF g', unfolded \<KK>.HomCod.cat_is_arrD[OF g]
     ]
 
 end
 
 end
 
 lemma the_cf_rKe_ArrMap_app_impl:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
     and "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<exists>!f.
     f : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and>
     u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = u' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret u: is_cat_limit \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> r u
     by (rule assms(4))
   interpret u': is_cat_limit \<alpha> \<open>c' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> r' u'
     by (rule assms(5))
 
   have const_r_def:
     "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>"
   proof(rule cf_eqI)
     show const_r: "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
     from assms(3) show const_r_g\<KK>: 
       "cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
     have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(3) have ObjMap_dom_rhs: 
       "\<D>\<^sub>\<circ> ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
-      by
+      by 
         (
-          cs_concl
-            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+          cs_concl 
+            cs_simp: cat_cs_simps 
+            cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
         )
     have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms(3) have ArrMap_dom_rhs: 
       "\<D>\<^sub>\<circ> ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       by
         (
           cs_concl
-            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+            cs_simp: cat_cs_simps 
+            cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
         )
     show 
       "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr> =
         (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>"
     proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
       fix A assume prems: "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
       from prems assms obtain b f 
         where A_def: "A = [0, b, f]\<^sub>\<circ>"
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
           and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by auto
       from assms(1,3) prems f b show 
         "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
           (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
         unfolding A_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps 
-              cs_intro: cat_cs_intros cat_comma_cs_intros
+              cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
           )
     qed (use assms(3) in \<open>cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros\<close>)+
     show
       "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr> =
         (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>"
     proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
       show "vsv (cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>)"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       from assms(3) show "vsv ((cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
         by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
       fix F assume prems: "F \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       with prems obtain A B where F: "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
         by (auto intro: is_arrI)
       with assms obtain b f b' f' h'
         where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [0, b, f]\<^sub>\<circ>"
           and B_def: "B = [0, b', f']\<^sub>\<circ>"
           and h': "h' : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and f': "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
         by auto
       from prems assms(3) F g' h' f f' show
         "cf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
           (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> r \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
         unfolding F_def A_def B_def
         by (*slow*)
           (
             cs_concl
               cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
-              cs_intro: cat_cs_intros cat_comma_cs_intros
+              cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
           )
     qed simp
   qed simp_all
 
   have \<TT>c'\<KK>: "\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>"
   proof(rule cf_eqI)
     show "\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (cs_concl cs_intro: cat_cs_intros)
     from assms show " \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by
         (
           cs_concl
             cs_simp: cat_cs_simps 
             cs_intro: cat_comma_cs_intros cat_cs_intros
         )
     have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms have ObjMap_dom_rhs: 
       "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
       by
         (
           cs_concl 
             cs_simp: cat_cs_simps 
             cs_intro: cat_comma_cs_intros cat_cs_intros
         )
     show "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr> = (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>"
     proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
       from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
         by
           (
             cs_concl
               cs_simp: cat_comma_cs_simps 
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
       from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
         by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
       fix A assume prems: "A \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
       from assms(3) prems obtain b f
         where A_def: "A = [0, b, f]\<^sub>\<circ>"
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by auto
       from prems assms b f show 
         "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
           (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
         unfolding A_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
     qed simp
 
     have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from assms have ArrMap_dom_rhs:
       "\<D>\<^sub>\<circ> ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       by
         (
           cs_concl
             cs_simp: cat_cs_simps
             cs_intro: cat_comma_cs_intros cat_cs_intros
         )
 
     show "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr> = (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>"
     proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
       from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
         by
           (
             cs_concl 
               cs_simp: cat_comma_cs_simps 
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
       from assms show "vsv ((\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
         by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
 
       fix F assume prems: "F \<in>\<^sub>\<circ> c' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
       with prems obtain A B where F: "F : A \<mapsto>\<^bsub>c' \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
         unfolding cat_comma_cs_simps by (auto intro: is_arrI)
       with assms(3) obtain b f b' f' h'
         where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [0, b, f]\<^sub>\<circ>"
           and B_def: "B = [0, b', f']\<^sub>\<circ>"
           and h': "h' : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
           and f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           and f': "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
           and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
         by auto
       from prems assms(3) F g' h' f f' show
         "(\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
           (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
         unfolding F_def A_def B_def
         by (*slow*)
           (
             cs_concl
               cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
-              cs_intro: cat_cs_intros cat_comma_cs_intros
+              cs_intro: cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
           )
     qed simp
   qed simp_all
 
   from assms(1-3) have
     "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     by (intro is_cat_coneI)
       (
         cs_concl
           cs_intro: cat_cs_intros cat_comma_cs_intros cat_lim_cs_intros
           cs_simp: const_r_def \<TT>c'\<KK>
       )+
   with u'.cat_lim_ua_fo show
     "\<exists>!G.
       G : r \<mapsto>\<^bsub>\<AA>\<^esub> r' \<and>
       u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = u' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> G"
     by simp
 
 qed
 
 lemma the_cf_rKe_ArrMap_app:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
     and "lim_Obj c\<lparr>UArr\<rparr> :
       lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "lim_Obj c'\<lparr>UArr\<rparr> :
       lim_Obj c'\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
     lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
     and
       "lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
         lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
           ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
     and 
       "\<lbrakk>
         f : lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>;
         lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
           lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
        \<rbrakk> \<Longrightarrow> f = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret u: is_cat_limit 
     \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
     by (rule assms(4))
   interpret u': is_cat_limit 
     \<alpha> \<open>c' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj c'\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c'\<lparr>UArr\<rparr>\<close>
     by (rule assms(5))
 
   from assms(3) have c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and c': "c' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
 
   note the_cf_rKe_ArrMap_app_impl' =
     the_cf_rKe_ArrMap_app_impl[OF assms]
   note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
   note the_f_is_arr = the_f[THEN conjunct1]
     and the_f_commutes = the_f[THEN conjunct2]
 
   from assms(3) the_f_is_arr show
     "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> :
       lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
     by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
   moreover from assms(3) the_f_commutes show
     "lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
       lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
         ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)"
     by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
   ultimately show "f = the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>"
     if "f : lim_Obj c\<lparr>UObj\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> lim_Obj c'\<lparr>UObj\<rparr>"
       and "lim_Obj c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F g \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
         lim_Obj c'\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c' \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
     by (metis that the_cf_rKe_ArrMap_app_impl')
 
 qed
 
 lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "g : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
     and "lim_Obj c\<lparr>UArr\<rparr> :
       lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "lim_Obj c'\<lparr>UArr\<rparr> :
       lim_Obj c'\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c' \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "a = lim_Obj c\<lparr>UObj\<rparr>"
     and "b = lim_Obj c'\<lparr>UObj\<rparr>"
   shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> b"
   unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])
 
 lemma lim_Obj_the_cf_rKe_commute:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "lim_Obj a\<lparr>UArr\<rparr> :
       lim_Obj a\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : a \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "lim_Obj b\<lparr>UArr\<rparr> :
       lim_Obj b\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : b \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b"
     and "[a', b', f']\<^sub>\<circ> \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
   shows  
     "lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
       lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
         the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" 
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   note f = \<KK>.HomCod.cat_is_arrD[OF assms(5)]
 
   interpret lim_a: is_cat_limit
     \<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj a\<lparr>UObj\<rparr>\<close> \<open>lim_Obj a\<lparr>UArr\<rparr>\<close>
     by (rule assms(3))
   interpret lim_b: is_cat_limit 
     \<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>lim_Obj b\<lparr>UObj\<rparr>\<close> \<open>lim_Obj b\<lparr>UArr\<rparr>\<close> 
     by (rule assms(4))
 
   note f_app = the_cf_rKe_ArrMap_app[
       where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
       ]
 
   from f_app(2) have lim_a_f\<KK>_NTMap_app:
     "(lim_Obj a\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F f \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
       (
         lim_Obj b\<lparr>UArr\<rparr> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F
         ntcf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)
       )\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
     if \<open>A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>\<close> for A
     by simp
   show 
     "lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
       lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
         the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>" 
   proof-
     from assms(5,6) have a'_def: "a' = 0"
       and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       by auto
     show 
       "lim_Obj a\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
         lim_Obj b\<lparr>UArr\<rparr>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
           the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       using lim_a_f\<KK>_NTMap_app[OF assms(6)] f' assms(3,4,5,6) 
       unfolding a'_def
       by
         (
           cs_prems
             cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
             cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
         )      
   qed
 
 qed
 
 
 subsubsection\<open>Natural transformation: natural transformation map\<close>
 
 mk_VLambda the_ntcf_rKe_components(1)
   |vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<AA> \<BB> \<CC> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 mk_VLambda the_ntcf_rKe_components'(1)[OF \<KK> \<TT>]
   |vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
   |app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
 
 end
 
 
 subsubsection\<open>The Kan extension is a Kan extension\<close>
 
 lemma the_cf_rKe_is_functor:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
       lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
 
   let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close> 
   let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
   let ?const_comma = \<open>\<lambda>a b. cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj b)\<close>
   let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj
   
   show ?thesis
   proof(intro is_functorI')
 
     show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
     show "vcard ?the_cf_rKe = 4\<^sub>\<nat>" 
       unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
     show "vsv (?the_cf_rKe\<lparr>ObjMap\<rparr>)" by (cs_concl cs_intro: cat_Kan_cs_intros)
     moreover show "\<D>\<^sub>\<circ> (?the_cf_rKe\<lparr>ObjMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
     moreover show "\<R>\<^sub>\<circ> (?the_cf_rKe\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     proof
       (
         intro the_cf_rKe_ObjMap_vrange; 
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
       )
       fix c assume "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
       with assms(3)[OF this] show "?UObj c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
     qed
     ultimately have [cat_Kan_cs_intros]: 
       "?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" if \<open>c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>\<close> for c
       by (metis that vsubsetE vsv.vsv_value)
 
     show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
       ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
       using assms(2) that
       by 
         (
           cs_concl
             cs_simp: cat_Kan_cs_simps 
             cs_intro: assms(3) cat_cs_intros cat_Kan_cs_intros
         )
     then have [cat_Kan_cs_intros]: "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>\<AA>\<^esub> B"
       if "A = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
         and "B = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         and "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" 
       for A B a b f
       by (simp add: that)
 
     show
       "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> =
         ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       (is \<open>?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = ?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f\<close>)
       if g_is_arr: "g : b \<mapsto>\<^bsub>\<CC>\<^esub> c" and f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for b c g a f
     proof-
 
       let ?ntcf_const_c = \<open>\<lambda>f. ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f\<close>
 
       note g = \<KK>.HomCod.cat_is_arrD[OF that(1)]
         and f = \<KK>.HomCod.cat_is_arrD[OF that(2)]
       note lim_a = assms(3)[OF f(2)]
         and lim_b = assms(3)[OF g(2)]
         and lim_c = assms(3)[OF g(3)]
       from that have gf: "g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f : a \<mapsto>\<^bsub>\<CC>\<^esub> c" 
         by (cs_concl cs_intro: cat_cs_intros)
 
       interpret lim_a: is_cat_limit
         \<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj a\<close> \<open>?UArr a\<close>
         by (rule lim_a)
       interpret lim_c: is_cat_limit
         \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
         by (rule lim_c)
 
       show ?thesis
       proof
         (
           rule sym, 
           rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
         )
 
         from assms(1,2) that lim_a lim_b lim_c show 
           "?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f : ?UObj a \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
           by
             (
               cs_concl
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
             )
       
         show
           "?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = 
             ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c (?the_rKe_g \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_rKe_f)"
           (
             is 
               \<open>
                 ?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =
                   ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf
               \<close>
            )
         proof(rule ntcf_eqI)
           from that show 
             "?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
               cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj a) \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
               \<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F ((g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>) :
               c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
             by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
           have [cat_comma_cs_simps]: 
             "?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = ?const_comma c a"
           proof(rule cf_eqI)
             from g_is_arr f_is_arr show
               "?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
               by
                 (
                   cs_concl
                     cs_simp: cat_comma_cs_simps cat_cs_simps
                     cs_intro: 
                       cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                 )
             from g_is_arr f_is_arr show "?const_comma c a : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
               by
                 (
                   cs_concl
                     cs_simp: cat_comma_cs_simps cat_cs_simps
                     cs_intro: 
                       cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                 )
             from g_is_arr f_is_arr have ObjMap_dom_lhs:
               "\<D>\<^sub>\<circ> ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>) =
                 c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               by
                 (
                   cs_concl
                     cs_simp: cat_comma_cs_simps cat_cs_simps 
                     cs_intro: 
                       cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                 )
             from g_is_arr f_is_arr have ObjMap_dom_rhs:
               "\<D>\<^sub>\<circ> (?const_comma c a\<lparr>ObjMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
 
             show
               "(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr> =
                 ?const_comma c a\<lparr>ObjMap\<rparr>"
             proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
               from f_is_arr g_is_arr show 
                 "vsv ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>)"
                 by
                   (
                     cs_concl
                       cs_simp: cat_comma_cs_simps cat_cs_simps 
                       cs_intro:
                         cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                   )
               fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               with g_is_arr obtain b' f' 
                 where A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                   and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 by auto
               from prems b' f' g_is_arr f_is_arr show 
                 "(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> =
                   ?const_comma c a\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
                 unfolding A_def
                 by
                   (
                     cs_concl
                       cs_simp: cat_comma_cs_simps cat_cs_simps 
                       cs_intro:
                         cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                   )
             qed (cs_concl cs_intro: cat_cs_intros)
 
             from g_is_arr f_is_arr have ArrMap_dom_lhs:
               "\<D>\<^sub>\<circ> ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>) = 
                 c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
               by
                 (
                   cs_concl
                     cs_simp: cat_comma_cs_simps cat_cs_simps 
                     cs_intro: 
                       cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                 )
             from g_is_arr f_is_arr have ArrMap_dom_rhs:
               "\<D>\<^sub>\<circ> (?const_comma c a\<lparr>ArrMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
               by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
 
             show 
               "(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr> =
                 ?const_comma c a\<lparr>ArrMap\<rparr>"
             proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
               from f_is_arr g_is_arr show
                 "vsv ((?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>)"
                 by
                   (
                     cs_concl
                       cs_simp: cat_comma_cs_simps cat_cs_simps
                       cs_intro:
                         cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                   )
               fix F assume "F \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Arr\<rparr>"
               then obtain A B where F: "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
                 unfolding cat_comma_cs_simps by (auto intro: is_arrI)
               with g_is_arr obtain b' f' b'' f'' h'
                 where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
                   and A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
                   and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
                   and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                   and f'': "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
                   and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
                 by auto
               from F f_is_arr g_is_arr g' h' f' f'' show 
                 "(?const_comma a a \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
                   ?const_comma c a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr>"
                 unfolding F_def A_def B_def
                 by
                   (
                     cs_concl
                       cs_intro:
                         cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
                       cs_simp: 
                         cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                   )
             qed (cs_concl cs_intro: cat_cs_intros)
           qed simp_all
 
           from that show
             "?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf :
               cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj a) \<circ>\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
               \<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F ((g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>) :
               c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
             by
               (
                 cs_concl
-                  cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps 
-                  cs_intro: cat_comma_cs_intros cat_Kan_cs_intros cat_cs_intros
+                  cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps
+                  cs_intro: 
+                    cat_lim_cs_intros
+                    cat_comma_cs_intros
+                    cat_Kan_cs_intros
+                    cat_cs_intros
               )
           from that have dom_lhs:
             "\<D>\<^sub>\<circ> ((?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             by
               (
                 cs_concl
                   cs_intro: cat_cs_intros cat_comma_cs_intros
                   cs_simp: cat_cs_simps cat_comma_cs_simps
               )
           from that have dom_rhs: 
             "\<D>\<^sub>\<circ> ((?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>) = 
               c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             by
               (
                 cs_concl
                   cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                   cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
               )
           show 
             "(?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> =
               (?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>"
           proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
             fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             with g_is_arr obtain b' f' 
               where A_def: "A = [0, b', f']\<^sub>\<circ>"
                 and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                 and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
               by auto
             note \<TT>.HomCod.cat_Comp_assoc[cat_cs_simps del]
               and \<KK>.HomCod.cat_Comp_assoc[cat_cs_simps del]
               and category.cat_Comp_assoc[cat_cs_simps del]
             note [symmetric, cat_cs_simps] =
               lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
               \<KK>.HomCod.cat_Comp_assoc  
               \<TT>.HomCod.cat_Comp_assoc
             from assms(1,2) that prems lim_a lim_b lim_c b' f' show
               "(?UArr a \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (g \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
                 (?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c ?the_rKe_gf)\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
               unfolding A_def
               by (*very slow*)
                 (
                   cs_concl
                     cs_simp:
                       cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps 
                     cs_intro: 
                       cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                 )+
           qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
         qed simp_all
       qed
     qed
     
     show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr> = \<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>"
       if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
     proof-
 
       let ?ntcf_const_c = \<open>ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<AA>\<lparr>CId\<rparr>\<lparr>?UObj c\<rparr>)\<close>
 
       note lim_c = assms(3)[OF that]
 
       from that have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c" 
         by (cs_concl cs_intro: cat_cs_intros)
 
       interpret lim_c: is_cat_limit 
         \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
         by (rule lim_c)
 
       show ?thesis
       proof
         (
           rule sym,
           rule the_cf_rKe_ArrMap_app(3)[
             where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
             ]
         )
         from that lim_c show 
           "\<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr> : ?UObj c \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
           by 
             (
               cs_concl
                 cs_simp: cat_Kan_cs_simps
                 cs_intro: cat_cs_intros cat_lim_cs_intros
             )
         have "?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> =  ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c"
         proof(rule ntcf_eqI)
           from lim_c that show 
             "?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
               cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj c) \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
               \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
               c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
             by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
           from lim_c that show 
             "?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c :
                cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj c) \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F
                \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> \<circ>\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> :
                c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
             by (*very slow*)
               (
                 cs_concl 
                   cs_intro: cat_cs_intros 
-                  cs_simp: \<KK>.cf_cf_arr_comma_CId cat_cs_simps 
+                  cs_simp: \<KK>.cf_arr_cf_comma_CId cat_cs_simps 
                   cs_intro: cat_lim_cs_intros
               )
           from that have dom_lhs:
             "\<D>\<^sub>\<circ> ((?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             by 
               (
                 cs_concl 
                   cs_simp: cat_cs_simps 
                   cs_intro: cat_cs_intros cat_comma_cs_intros
               )
+          
           from that have dom_rhs:
             "\<D>\<^sub>\<circ> ((?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             by
               (
                 cs_concl
                   cs_intro: cat_lim_cs_intros cat_cs_intros 
                   cs_simp: cat_cs_simps
               )
           show 
             "(?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr> =
               (?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>"
           proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
             fix A assume prems: "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
             with that obtain b f 
               where A_def: "A = [0, b, f]\<^sub>\<circ>"
                 and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
                 and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
               by auto
             from that prems f have 
               "?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> : ?UObj c \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
               unfolding A_def
               by
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_comma_cs_simps 
                     cs_intro: cat_comma_cs_intros cat_cs_intros
                 )
             from that prems f show 
               "(?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
                 (?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_const_c)\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
               unfolding A_def 
               by
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_comma_cs_simps
                     cs_intro: 
                       cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
                 )
           qed (cs_concl cs_intro: cat_cs_intros)
         qed simp_all
 
         with that show 
           "?UArr c \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) \<^sub>A\<down>\<^sub>C\<^sub>F \<KK> = 
             ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<AA>\<lparr>CId\<rparr>\<lparr>?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<rparr>)"
           by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
 
       qed
 
     qed
 
   qed
     (
       cs_concl
         cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
     )+
 
 qed
 
+lemma the_cf_lKe_is_functor:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+  shows "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+proof-
+  interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  {
+    fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+    from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>". 
+    then interpret lim_Obj_c: is_cat_colimit 
+      \<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
+      by simp
+    note op_ua_UArr_is_cat_limit'[
+      where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
+      ]
+  }
+  note the_cf_rKe_is_functor = the_cf_rKe_is_functor
+    [
+      OF \<KK>.is_functor_op \<TT>.is_functor_op,
+      unfolded cat_op_simps,
+      where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>, 
+      unfolded cat_op_simps, 
+      OF this,
+      simplified,
+      folded the_cf_lKe_def
+    ]
+  show "the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by 
+      (
+        rule is_functor.is_functor_op
+          [
+            OF the_cf_rKe_is_functor, 
+            folded the_cf_lKe_def,
+            unfolded cat_op_simps
+          ]
+      )
+qed
+
 lemma the_ntcf_rKe_is_ntcf:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> : 
       lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj :
     the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
 
   let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close> 
   let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
   let ?const_comma = \<open>\<lambda>a b. cf_const (a \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (?UObj b)\<close>
   let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
   let ?the_ntcf_rKe = \<open>the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret cf_rKe: is_functor \<alpha> \<CC> \<AA> \<open>?the_cf_rKe\<close>
     by (rule the_cf_rKe_is_functor[OF assms, simplified])
 
   show ?thesis
   proof(rule is_ntcfI')
     show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
     show "vcard ?the_ntcf_rKe = 5\<^sub>\<nat>"
       unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
     show "?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>b\<rparr> : 
       (?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     proof-
       let ?\<KK>b = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>
       from that have \<KK>b: "\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         by (cs_concl cs_intro: cat_cs_intros)
       note lim_\<KK>b = assms(3)[OF \<KK>b]
       interpret lim_\<KK>b: is_cat_limit 
         \<alpha> \<open>?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b\<close> \<open>?UArr ?\<KK>b\<close>
         by (rule lim_\<KK>b)
       from that lim_\<KK>b show ?thesis
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
               cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
           )+
     qed
     show 
       "?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> (?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         \<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_ntcf_rKe\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       if "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b" for a b f 
     proof-
       let ?\<KK>a = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<close> and ?\<KK>b = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close> and ?\<KK>f = \<open>\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
       from that have \<KK>a: "?\<KK>a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
         and \<KK>b: "?\<KK>b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
         and \<KK>f: "?\<KK>f : ?\<KK>a \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
       note lim_\<KK>a = assms(3)[OF \<KK>a]
         and lim_\<KK>b = assms(3)[OF \<KK>b]
       from that have z_b_\<KK>b: "[0, b, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
         by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
       from 
         lim_Obj_the_cf_rKe_commute[
           OF assms(1,2) lim_\<KK>a lim_\<KK>b \<KK>f z_b_\<KK>b, symmetric
           ]
         that
       have [cat_Kan_cs_simps]:
         "?UArr ?\<KK>b\<lparr>NTMap\<rparr>\<lparr>0, b, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>?\<KK>f\<rparr> =
           ?UArr ?\<KK>a\<lparr>NTMap\<rparr>\<lparr>0, b, ?\<KK>f\<rparr>\<^sub>\<bullet>"
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       interpret lim_\<KK>a: is_cat_limit
         \<alpha> \<open>?\<KK>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>a\<close> \<open>?UArr ?\<KK>a\<close>
         by (rule lim_\<KK>a)
       interpret lim_\<KK>b: is_cat_limit 
         \<alpha> \<open>?\<KK>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b\<close> \<open>?UArr ?\<KK>b\<close>
         by (rule lim_\<KK>b)
       from that have 
         "[[0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>]\<^sub>\<circ>, [0, b, ?\<KK>f]\<^sub>\<circ>, [0, f]\<^sub>\<circ>]\<^sub>\<circ> :
           [0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>]\<^sub>\<circ> \<mapsto>\<^bsub>(?\<KK>a) \<down>\<^sub>C\<^sub>F \<KK>\<^esub> [0, b, ?\<KK>f]\<^sub>\<circ>"
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_comma_cs_simps
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
       from lim_\<KK>a.ntcf_Comp_commute[OF this, symmetric] that
       have [cat_Kan_cs_simps]:
         "\<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?UArr (?\<KK>a)\<lparr>NTMap\<rparr> \<lparr>0, a, \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>a\<rparr>\<rparr>\<^sub>\<bullet> =
           ?UArr ?\<KK>a\<lparr>NTMap\<rparr>\<lparr>0, b, ?\<KK>f\<rparr>\<^sub>\<bullet>"
         by
           (
             cs_prems
               cs_simp: cat_cs_simps cat_comma_cs_simps
               cs_intro: cat_cs_intros cat_comma_cs_intros \<Z>.cat_1_is_arrI
           )
       from that show ?thesis
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
           )
     qed
   qed
     (
       cs_concl
         cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
     )+
 
 qed
 
+lemma the_ntcf_lKe_is_ntcf:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+  shows "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
+    \<TT> \<mapsto>\<^sub>C\<^sub>F the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+proof-
+  interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  {
+    fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+    from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>". 
+    then interpret lim_Obj_c: is_cat_colimit 
+      \<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
+      by simp
+    note op_ua_UArr_is_cat_limit'[
+      where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
+      ]
+  }
+  note the_ntcf_rKe_is_ntcf = the_ntcf_rKe_is_ntcf
+    [
+      OF \<KK>.is_functor_op \<TT>.is_functor_op,
+      unfolded cat_op_simps,
+      where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>,
+      unfolded cat_op_simps,
+      OF this,
+      simplified
+    ]
+  show "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
+    \<TT> \<mapsto>\<^sub>C\<^sub>F the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by 
+      (
+        rule is_ntcf.is_ntcf_op
+          [
+            OF the_ntcf_rKe_is_ntcf,
+            unfolded cat_op_simps, 
+            folded the_cf_lKe_def the_ntcf_lKe_def
+          ]
+       )
+qed
+
 lemma the_ntcf_rKe_is_cat_rKe:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
       lim_Obj c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj :
     the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
 proof-
 
   let ?UObj = \<open>\<lambda>a. lim_Obj a\<lparr>UObj\<rparr>\<close> 
   let ?UArr = \<open>\<lambda>a. lim_Obj a\<lparr>UArr\<rparr>\<close>
   let ?the_cf_rKe = \<open>the_cf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
   let ?the_ntcf_rKe = \<open>the_ntcf_rKe \<alpha> \<TT> \<KK> lim_Obj\<close>
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret cf_rKe: is_functor \<alpha> \<CC> \<AA> ?the_cf_rKe
     by (rule the_cf_rKe_is_functor[OF assms, simplified])
   interpret ntcf_rKe: is_ntcf \<alpha> \<BB> \<AA> \<open>?the_cf_rKe \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> ?the_ntcf_rKe
     by (intro the_ntcf_rKe_is_ntcf assms(3))
       (cs_concl cs_intro: cat_cs_intros)+
 
   show ?thesis
   proof(rule is_cat_rKeI')
 
     fix \<GG> \<epsilon> assume prems: 
       "\<GG> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 
     interpret \<GG>: is_functor \<alpha> \<CC> \<AA> \<GG> by (rule prems(1))
     interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon> by (rule prems(2))
 
     define \<epsilon>' where "\<epsilon>' c =
       [
         (\<lambda>A\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<epsilon>\<lparr>NTMap\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>A\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>),
         cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>),
         \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
         c \<down>\<^sub>C\<^sub>F \<KK>,
         \<AA>
       ]\<^sub>\<circ>"
       for c
 
     have \<epsilon>'_components: 
       "\<epsilon>' c\<lparr>NTMap\<rparr> = (\<lambda>A\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<epsilon>\<lparr>NTMap\<rparr>\<lparr>A\<lparr>1\<^sub>\<nat>\<rparr>\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>A\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>)"
       "\<epsilon>' c\<lparr>NTDom\<rparr> = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)"
       "\<epsilon>' c\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
       "\<epsilon>' c\<lparr>NTDGDom\<rparr> = c \<down>\<^sub>C\<^sub>F \<KK>"
       "\<epsilon>' c\<lparr>NTDGCod\<rparr> = \<AA>"
       for c 
       unfolding \<epsilon>'_def nt_field_simps by (simp_all add: nat_omega_simps)
     note [cat_Kan_cs_simps] = \<epsilon>'_components(2-5)
     have [cat_Kan_cs_simps]: "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "A = [a, b, f]\<^sub>\<circ>" and "[a, b, f]\<^sub>\<circ> \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A a b c f
       using that unfolding \<epsilon>'_components by (auto simp: nat_omega_simps)
 
     have \<epsilon>': "\<epsilon>' c : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       and \<epsilon>'_unique: "\<exists>!f'.
         f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
         \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f'" 
       if c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
     proof-
       from that have "?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> = ?UObj c"
         by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
       interpret lim_c: is_cat_limit 
         \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
         by (rule assms(3)[OF that])
       show "\<epsilon>' c : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       proof(intro is_cat_coneI is_ntcfI')
         show "vfsequence (\<epsilon>' c)" unfolding \<epsilon>'_def by simp
         show "vcard (\<epsilon>' c) = 5\<^sub>\<nat>" unfolding \<epsilon>'_def by (simp add: nat_omega_simps)
         show "vsv (\<epsilon>' c\<lparr>NTMap\<rparr>)" unfolding \<epsilon>'_components by simp 
         show "\<D>\<^sub>\<circ> (\<epsilon>' c\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" unfolding \<epsilon>'_components by simp
         show "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> :
           cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub>
           (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
           if "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A
         proof-
           from that prems c obtain b f 
             where A_def: "A = [0, b, f]\<^sub>\<circ>"
               and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
               and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
             by auto
           from that prems f c that b f show ?thesis
             unfolding A_def
             by
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
                   cs_intro: cat_cs_intros cat_comma_cs_intros
               )
         qed
         show
           "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
             (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
           if "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
         proof-
           from that c 
           obtain b f b' f' k 
             where F_def: "F = [[0, b, f]\<^sub>\<circ>, [0, b', f']\<^sub>\<circ>, [0, k]\<^sub>\<circ>]\<^sub>\<circ>"
               and A_def: "A = [0, b, f]\<^sub>\<circ>"
               and B_def: "B = [0, b', f']\<^sub>\<circ>"
               and k: "k : b \<mapsto>\<^bsub>\<BB>\<^esub> b'"
               and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
               and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
               and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>k\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'"
             by auto
           from c that k f f' show ?thesis
             unfolding F_def A_def B_def
             by (*slow*)
               (
                 cs_concl
                   cs_simp:
                     cat_cs_simps
                     cat_comma_cs_simps
                     cat_Kan_cs_simps
                     \<epsilon>.ntcf_Comp_commute''
                     f'_def[symmetric]
                   cs_intro: cat_cs_intros cat_comma_cs_intros
               )
         qed
       qed
         (
           use c that in
             \<open>cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros\<close>
         )+
       from is_cat_limit.cat_lim_ua_fo[OF assms(3)[OF that] this] show 
         "\<exists>!f'.
           f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
           \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f'"  
         by simp
     qed
 
     define \<sigma> :: V where
       "\<sigma> =
         [
           (
             \<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f.
               f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
               \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
           ),
           \<GG>,
           ?the_cf_rKe,
           \<CC>,
           \<AA>
         ]\<^sub>\<circ>"
 
     have \<sigma>_components:
       "\<sigma>\<lparr>NTMap\<rparr> =
         (
           \<lambda>c\<in>\<^sub>\<circ>\<CC>\<lparr>Obj\<rparr>. THE f.
             f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
             \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
         )"
       "\<sigma>\<lparr>NTDom\<rparr> = \<GG>"
       "\<sigma>\<lparr>NTCod\<rparr> = ?the_cf_rKe"
       "\<sigma>\<lparr>NTDGDom\<rparr> = \<CC>"
       "\<sigma>\<lparr>NTDGCod\<rparr> = \<AA>"
       unfolding \<sigma>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
     note [cat_Kan_cs_simps] = \<sigma>_components(2-5)
 
     have \<sigma>_NTMap_app_def: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> =
       (
         THE f.
           f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
           \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
       )"
       if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c
       using that unfolding \<sigma>_components by simp
 
     have \<sigma>_NTMap_app_is_arr: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
       and \<epsilon>'_\<sigma>_commute:
         "\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
       and \<sigma>_NTMap_app_unique:
         "\<lbrakk>
           f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c;
           \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f
          \<rbrakk> \<Longrightarrow> f = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
         if c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for c f
     proof-
       have 
         "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c \<and>
         \<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
         by 
           (
             cs_concl 
               cs_simp: cat_Kan_cs_simps \<sigma>_NTMap_app_def 
               cs_intro: theI' \<epsilon>'_unique that
           )
       then show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
         and "\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>)"
         by simp_all
       with c \<epsilon>'_unique[OF c] show "f = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
         if "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
           and "\<epsilon>' c = ?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> f"
         using that by metis
     qed
 
     have \<sigma>_NTMap_app_is_arr'[cat_Kan_cs_intros]: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> : a \<mapsto>\<^bsub>\<AA>'\<^esub> b"
       if "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
         and "a = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>" 
         and "b = ?UObj c" 
         and "\<AA>' = \<AA>"
       for \<AA>' a b c
       by (simp add: that \<sigma>_NTMap_app_is_arr)
 
     have \<epsilon>'_NTMap_app_def: 
       "\<epsilon>' c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
         (?UArr c \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>))\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
       if "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for A c
       using \<epsilon>'_\<sigma>_commute[OF that(2)] by simp
     have \<epsilon>b_\<GG>f:
       "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         ?UArr c\<lparr>NTMap\<rparr>\<lparr>a, b, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
       if "A = [a, b, f]\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
       for A a b c f
     proof-
       interpret lim_c: is_cat_limit 
         \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
         by (rule assms(3)[OF that(3)])
       from that have b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by blast+
       show
         "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
           ?UArr c\<lparr>NTMap\<rparr>\<lparr>a, b, f\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
         using \<epsilon>'_NTMap_app_def[OF that(2,3)] that(2,3)
         unfolding that(1)
         by
           (
             cs_prems
               cs_simp: cat_cs_simps cat_Kan_cs_simps
               cs_intro: cat_cs_intros cat_Kan_cs_intros
           )
     qed
 
     show "\<exists>!\<sigma>.
       \<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and>
       \<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
     proof(intro ex1I[where a=\<sigma>] conjI; (elim conjE)?)
 
       define \<tau> where "\<tau> a b f =
         [
           (
             \<lambda>F\<in>\<^sub>\<circ>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>.
               ?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
           ),
           cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>),
           \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
           b \<down>\<^sub>C\<^sub>F \<KK>,
           \<AA>
         ]\<^sub>\<circ>"
         for a b f
 
       have \<tau>_components:
         "\<tau> a b f\<lparr>NTMap\<rparr> =
           (
             \<lambda>F\<in>\<^sub>\<circ>b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>.
               ?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>
           )"
         "\<tau> a b f\<lparr>NTDom\<rparr> = cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)"
         "\<tau> a b f\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
         "\<tau> a b f\<lparr>NTDGDom\<rparr> = b \<down>\<^sub>C\<^sub>F \<KK>"
         "\<tau> a b f\<lparr>NTDGCod\<rparr> = \<AA>"
         for a b f
         unfolding \<tau>_def nt_field_simps by (simp_all add: nat_omega_simps)
       note [cat_Kan_cs_simps] = \<tau>_components(2-5)
       have \<tau>_NTMap_app[cat_Kan_cs_simps]: 
         "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>F\<rparr> =
           ?UArr b\<lparr>NTMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
         if "F \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for a b f F
         using that unfolding \<tau>_components by auto
       
       have \<tau>: "\<tau> a b f :
         \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : b \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         if f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
       proof-
 
         note f = \<KK>.HomCod.cat_is_arrD[OF that]
         note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
 
         interpret lim_b: is_cat_limit 
           \<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj b\<close> \<open>?UArr b\<close>
           by (rule lim_b)
         
         from f have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
 
         show ?thesis
         proof(intro is_cat_coneI is_ntcfI')
 
           show "vfsequence (\<tau> a b f)" unfolding \<tau>_def by simp
           show "vcard (\<tau> a b f) = 5\<^sub>\<nat>" 
             unfolding \<tau>_def by (simp add: nat_omega_simps)
           show "vsv (\<tau> a b f\<lparr>NTMap\<rparr>)" unfolding \<tau>_components by auto
           show "\<D>\<^sub>\<circ> (\<tau> a b f\<lparr>NTMap\<rparr>) = b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" by (auto simp: \<tau>_components)
           show "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> :
             cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub>
             (\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>A\<rparr>"
             if "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A
           proof-
             from that f_is_arr obtain b' f' 
               where A_def: "A = [0, b', f']\<^sub>\<circ>"
                 and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                 and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
               by auto
             from  f_is_arr that b' f' a b show ?thesis
               unfolding A_def
               by
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                     cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                 )   
           qed
           show
             "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
               cf_const (b \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
               (\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
             if "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
           proof-
             from that have F: "F : A \<mapsto>\<^bsub>b \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
               by (auto intro: is_arrI)
             with f_is_arr obtain b' f' b'' f'' h'
               where F_def: "F = [[0, b', f']\<^sub>\<circ>, [0, b'', f'']\<^sub>\<circ>, [0, h']\<^sub>\<circ>]\<^sub>\<circ>"
                 and A_def: "A = [0, b', f']\<^sub>\<circ>"
                 and B_def: "B = [0, b'', f'']\<^sub>\<circ>"
                 and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
                 and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 and f'': "f'' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
                 and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
               by auto
             from
               lim_b.ntcf_Comp_commute[OF that] 
               that f_is_arr g' h' f' f'' 
             have [cat_Kan_cs_simps]:
               "?UArr b\<lparr>NTMap\<rparr>\<lparr>0, b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> =
                 \<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?UArr b\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet>"
               unfolding F_def A_def B_def
               by
                 (
                   cs_prems
                     cs_simp: 
                       cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                     cs_intro: cat_cs_intros cat_comma_cs_intros
                 )
             from f_is_arr that g' h' f' f'' show ?thesis
               unfolding F_def A_def B_def (*very slow*)
               by
                 (
                   cs_concl
                     cs_simp:
                       cat_cs_simps 
                       cat_Kan_cs_simps 
                       cat_comma_cs_simps 
                       f''_def[symmetric]
                     cs_intro:
                       cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                 )+
           qed
 
         qed
           (
             use that f_is_arr in
               \<open>
                 cs_concl
                   cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
               \<close>
           )+
       qed
 
       show \<sigma>: "\<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       proof(rule is_ntcfI')
 
         show "vfsequence \<sigma>" unfolding \<sigma>_def by simp
         show "vcard \<sigma> = 5\<^sub>\<nat>" unfolding \<sigma>_def by (simp add: nat_omega_simps)
         show "vsv (\<sigma>\<lparr>NTMap\<rparr>)" unfolding \<sigma>_components by auto
         show "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>" unfolding \<sigma>_components by simp
         show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
           if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" for a
           using that 
           by
             (
               cs_concl
                 cs_simp: cat_cs_simps cat_Kan_cs_simps
                 cs_intro: cat_cs_intros cat_Kan_cs_intros
             )
 
         then have [cat_Kan_cs_intros]: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : b \<mapsto>\<^bsub>\<AA>\<^esub> c"
           if "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
             and "b = \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" 
             and "c = ?the_cf_rKe\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
           for a b c
           using that(1) unfolding that(2,3) by simp
 
         show 
           "\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
             ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           if f_is_arr: "f : a \<mapsto>\<^bsub>\<CC>\<^esub> b" for a b f
         proof-
 
           note f = \<KK>.HomCod.cat_is_arrD[OF that]
           note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
 
           interpret lim_a: is_cat_limit 
             \<alpha> \<open>a \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F a \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj a\<close> \<open>?UArr a\<close>
             by (rule lim_a)
           interpret lim_b: is_cat_limit 
             \<alpha> \<open>b \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F b \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj b\<close> \<open>?UArr b\<close>
             by (rule lim_b)
 
           from f have a: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
           
           from lim_b.cat_lim_unique_cone'[OF \<tau>[OF that]] obtain g' 
             where g': "g' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b"
               and \<tau>_NTMap_app: "\<And>A. A \<in>\<^sub>\<circ> (b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>) \<Longrightarrow>
                 \<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g'"
               and g'_unique: "\<And>g''.
                 \<lbrakk>
                   g'' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b;
                   \<And>A. A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
                     \<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> g''
                 \<rbrakk> \<Longrightarrow> g'' = g'"
             by metis
 
           have lim_Obj_a_f\<KK>[symmetric, cat_Kan_cs_simps]:
             "?UArr a\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet> =
               ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
             if "A = [a', b', f']\<^sub>\<circ>" and "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for A a' b' f'
           proof-
             from that(2) f_is_arr have a'_def: "a' = 0" 
               and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" 
               and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
               unfolding that(1) by auto
             show ?thesis 
               unfolding that(1) 
               by 
                 (
                   rule 
                     lim_Obj_the_cf_rKe_commute
                       [
                         where lim_Obj=lim_Obj, 
                         OF 
                           assms(1,2) 
                           lim_a 
                           lim_b 
                           f_is_arr 
                           that(2)[unfolded that(1)] 
                       ]
                 )
           qed
           {
             fix a' b' f' A
             note \<TT>.HomCod.cat_assoc_helper[
               where h=\<open>?UArr b\<lparr>NTMap\<rparr>\<lparr>a',b',f'\<rparr>\<^sub>\<bullet>\<close> 
                 and g=\<open>?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>\<close>
                 and q=\<open>?UArr a\<lparr>NTMap\<rparr>\<lparr>a', b', f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr>\<^sub>\<bullet>\<close>
                 ]
           }
           note [cat_Kan_cs_simps] = this
 
           show ?thesis
           proof(rule trans_sym[where s=g'])
             show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = g'"
             proof(rule g'_unique)
               from that show
                 "\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj b"
                 by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
               fix A assume prems': "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               with f_is_arr obtain b' f' 
                 where A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                   and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 by auto
               from f_is_arr prems' show
                 "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
                   ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>)"
                 unfolding A_def
                 by
                   (
                     cs_concl
                       cs_simp: cat_cs_simps cat_Kan_cs_simps
                       cs_intro: cat_cs_intros cat_Kan_cs_intros
                   )
             qed
             show "?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = g'"
             proof(rule g'_unique)                  
               fix A assume prems': "A \<in>\<^sub>\<circ> b \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               with f_is_arr obtain b' f' 
                 where A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                   and f': "f' : b \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 by auto
               {
                 fix a' b' f' A
                 note \<TT>.HomCod.cat_assoc_helper
                   [
                     where h=\<open>?UArr b\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>\<close> 
                       and g=\<open>\<sigma>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<close>
                       and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>\<close>
                   ]
               }
               note [cat_Kan_cs_simps] = 
                 this
                 \<epsilon>b_\<GG>f[OF A_def prems' b, symmetric]
                 \<epsilon>b_\<GG>f[symmetric]
               from f_is_arr prems' b' f' show 
                 "\<tau> a b f\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
                   ?UArr b\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
                     (?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>)"
                 unfolding A_def
                 by
                   (
                     cs_concl 
                       cs_simp: 
                         cat_cs_simps 
                         cat_Kan_cs_simps 
                         cat_comma_cs_simps
                         cat_op_simps
                       cs_intro: 
                         cat_cs_intros 
                         cat_Kan_cs_intros 
                         cat_comma_cs_intros 
                         cat_op_intros
                   )
             qed
               (
                 use that in
                   \<open>
                     cs_concl
                       cs_simp: cat_Kan_cs_simps
                       cs_intro: cat_cs_intros cat_Kan_cs_intros
                   \<close>
               )
           qed
         qed
       qed
         (
           cs_concl
             cs_simp: cat_cs_simps cat_Kan_cs_simps
             cs_intro: cat_cs_intros
         )+
       then interpret \<sigma>: is_ntcf \<alpha> \<CC> \<AA> \<GG> \<open>?the_cf_rKe\<close> \<sigma> by simp
 
       show "\<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
       proof(rule ntcf_eqI)
         have dom_lhs: "\<D>\<^sub>\<circ> (\<epsilon>\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>" 
           by (cs_concl cs_simp: cat_cs_simps)
         have dom_rhs: "\<D>\<^sub>\<circ> ((?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         show "\<epsilon>\<lparr>NTMap\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
           fix b assume prems': "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           note [cat_Kan_cs_simps] = \<epsilon>b_\<GG>f[
             where f=\<open>\<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<rparr>\<close> and c=\<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>\<close>, symmetric
             ]
           from prems' \<sigma> show 
             "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
             by
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                   cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
               )
         qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
       qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
 
       fix \<sigma>' assume prems':
         "\<sigma>' : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         "\<epsilon> = ?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
 
       interpret \<sigma>': is_ntcf \<alpha> \<CC> \<AA> \<GG> \<open>?the_cf_rKe\<close> \<sigma>' by (rule prems'(1))
 
       have \<epsilon>_NTMap_app[symmetric, cat_Kan_cs_simps]: 
         "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> =
           ?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
           \<sigma>'\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>"
         if "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "a' = 0" for a' b'
       proof-
         from prems'(2) have \<epsilon>_NTMap_app: 
           "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = (?the_ntcf_rKe \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
           for b'
           by simp
         show ?thesis
           using \<epsilon>_NTMap_app[of b'] that(1)
           unfolding that(2)
           by
             (
               cs_prems
                 cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                 cs_intro: cat_cs_intros cat_comma_cs_intros
             )
       qed
       {
         fix a' b' f' A
         note \<TT>.HomCod.cat_assoc_helper
           [
             where h=
               \<open>?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>\<close>
               and g=\<open>\<sigma>'\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
               and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
           ]
       }
       note [cat_Kan_cs_simps] = this \<epsilon>b_\<GG>f[symmetric]
       {
         fix a' b' f' A
         note \<TT>.HomCod.cat_assoc_helper
           [
-            where h=\<open>
-              ?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>
-                a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>
-                \<rparr>\<^sub>\<bullet>\<close>
+            where h=
+              \<open>?UArr (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<lparr>NTMap\<rparr>\<lparr>a', b', \<CC>\<lparr>CId\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<rparr>\<^sub>\<bullet>\<close>
             and g=\<open>\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
             and q=\<open>\<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>\<close>
           ]
       }
       note [cat_Kan_cs_simps] = this
 
       show "\<sigma>' = \<sigma>"
       proof(rule ntcf_eqI)
 
         show "\<sigma>' : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" by (rule prems'(1))
         show "\<sigma> : \<GG> \<mapsto>\<^sub>C\<^sub>F ?the_cf_rKe : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" by (rule \<sigma>)
 
         have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>" 
           by (cs_concl cs_simp: cat_cs_simps)
         have dom_rhs: "\<D>\<^sub>\<circ> (\<sigma>'\<lparr>NTMap\<rparr>) = \<CC>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps)
 
         show "\<sigma>'\<lparr>NTMap\<rparr> = \<sigma>\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
 
           fix c assume prems': "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 
           note lim_c = assms(3)[OF prems']
           interpret lim_c: is_cat_limit 
             \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj c\<close> \<open>?UArr c\<close>
             by (rule lim_c)
           from prems' have CId_c: "\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> c"
             by (cs_concl cs_intro: cat_cs_intros)
 
           from lim_c.cat_lim_unique_cone'[OF \<tau>[OF CId_c]] obtain f 
             where f: "f : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c"
               and "\<And>A. A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
                 \<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f"
               and f_unique: "\<And>f'.
                 \<lbrakk>
                   f' : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> ?UObj c;
                   \<And>A. A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr> \<Longrightarrow>
                     \<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> f'
                 \<rbrakk> \<Longrightarrow> f' = f"
             by metis
 
           note [symmetric, cat_cs_simps] =
             \<sigma>.ntcf_Comp_commute
             \<sigma>'.ntcf_Comp_commute
 
           show "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
           proof(rule trans_sym[where s=f])
 
             show "\<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = f"
             proof(rule f_unique)
 
               fix A assume prems'': "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
 
               with prems' obtain b' f' 
                 where A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                   and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 by auto
 
               let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
 
               from b' have \<KK>b': "?\<KK>b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
                 by (cs_concl cs_intro: cat_cs_intros)
 
               interpret lim_\<KK>b': is_cat_limit
                 \<alpha> \<open>?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b'\<close> \<open>?UArr ?\<KK>b'\<close>
                 by (rule assms(3)[OF \<KK>b'])
 
               from \<KK>b' have CId_\<KK>b': "\<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr> : ?\<KK>b' \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
                 by (cs_concl cs_intro: cat_cs_intros)
               from CId_\<KK>b' b' have a'_b'_CId_\<KK>b':
                 "[0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
                 by
                   (
                     cs_concl
                       cs_simp: cat_cs_simps cat_comma_cs_simps
                       cs_intro: cat_cs_intros cat_comma_cs_intros
                   )
               from 
                 lim_Obj_the_cf_rKe_commute[
                   where lim_Obj=lim_Obj, 
                   OF assms(1,2) lim_c assms(3)[OF \<KK>b'] f' a'_b'_CId_\<KK>b'
                   ]
                 f'
               have [cat_Kan_cs_simps]:
                 "?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet> =
                   ?UArr ?\<KK>b'\<lparr>NTMap\<rparr>\<lparr>0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> 
                     ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
                 by (cs_prems cs_simp: cat_cs_simps)
 
               from prems' prems'' b' f' show
                 "\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>'\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
                 unfolding A_def (*very slow*)
                 by
                   (
                     cs_concl
                       cs_simp:
                         cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                       cs_intro:
-                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
+                        cat_lim_cs_intros 
+                        cat_cs_intros 
+                        cat_comma_cs_intros   
+                        cat_Kan_cs_intros
                   )
 
             qed
               (
                 use prems' in
                   \<open>cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros\<close>
               )
 
             show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr> = f"
             proof(rule f_unique)
               fix A assume prems'': "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
               from this prems' obtain b' f' 
                 where A_def: "A = [0, b', f']\<^sub>\<circ>"
                   and b': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                   and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
                 by auto
               let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
               from b' have \<KK>b': "?\<KK>b' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
                 by (cs_concl cs_intro: cat_cs_intros)
               interpret lim_\<KK>b': is_cat_limit
                 \<alpha> \<open>?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F ?\<KK>b' \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>?UObj ?\<KK>b'\<close> \<open>?UArr ?\<KK>b'\<close>
                 by (rule assms(3)[OF \<KK>b'])
               from \<KK>b' have CId_\<KK>b': "\<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr> : ?\<KK>b' \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
                 by (cs_concl cs_intro: cat_cs_intros)
               from CId_\<KK>b' b' have a'_b'_CId_\<KK>b': 
                 "[0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>]\<^sub>\<circ> \<in>\<^sub>\<circ> ?\<KK>b' \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
                 by
                   (
                     cs_concl
                       cs_simp: cat_cs_simps cat_comma_cs_simps
                       cs_intro: cat_cs_intros cat_comma_cs_intros
                   )
 
               from 
                 lim_Obj_the_cf_rKe_commute
                   [
                     where lim_Obj=lim_Obj, 
                     OF assms(1,2) lim_c assms(3)[OF \<KK>b'] f' a'_b'_CId_\<KK>b'
                   ]
                 f'
               have [cat_Kan_cs_simps]:
                 "?UArr c\<lparr>NTMap\<rparr>\<lparr>0, b', f'\<rparr>\<^sub>\<bullet> =
                   ?UArr (?\<KK>b')\<lparr>NTMap\<rparr>\<lparr>0, b', \<CC>\<lparr>CId\<rparr>\<lparr>?\<KK>b'\<rparr>\<rparr>\<^sub>\<bullet> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub>
                     ?the_cf_rKe\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr>"
                 by (cs_prems cs_simp: cat_cs_simps)
               from prems' prems'' b' f' show
                 "\<tau> c c (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>)\<lparr>NTMap\<rparr>\<lparr>A\<rparr> = ?UArr c\<lparr>NTMap\<rparr>\<lparr>A\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<sigma>\<lparr>NTMap\<rparr>\<lparr>c\<rparr>"
                 unfolding A_def (*very slow*)
                 by
                   (
                     cs_concl
                       cs_simp:
                         cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                       cs_intro:
-                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
+                        cat_lim_cs_intros
+                        cat_cs_intros
+                        cat_comma_cs_intros
+                        cat_Kan_cs_intros
                   )
             qed
               (
                 use prems' in
                   \<open>cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros\<close>
               )
           qed
 
         qed auto
 
       qed simp_all
 
     qed
 
   qed (cs_concl cs_intro: cat_cs_intros)+
 
 qed
 
-
-
-subsection\<open>Preservation of Kan extension\<close>
+lemma the_ntcf_lKe_is_cat_lKe:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    and "\<And>c. c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr> \<Longrightarrow> lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+  shows "the_ntcf_lKe \<alpha> \<TT> \<KK> lim_Obj :
+    \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> the_cf_lKe \<alpha> \<TT> \<KK> lim_Obj \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
+proof-
+  interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  {
+    fix c assume prems: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+    from assms(3)[OF this] have lim_Obj_UArr: "lim_Obj c\<lparr>UArr\<rparr> :
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m lim_Obj c\<lparr>UObj\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>". 
+    then interpret lim_Obj_c: is_cat_colimit 
+      \<alpha> \<open>\<KK> \<^sub>C\<^sub>F\<down> c\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c\<close> \<open>lim_Obj c\<lparr>UObj\<rparr>\<close> \<open>lim_Obj c\<lparr>UArr\<rparr>\<close>
+      by simp
+    note op_ua_UArr_is_cat_limit'[
+      where lim_Obj=lim_Obj, OF assms(1,2) prems lim_Obj_UArr
+      ]
+  }
+  note the_ntcf_rKe_is_cat_rKe = the_ntcf_rKe_is_cat_rKe
+    [
+      OF \<KK>.is_functor_op \<TT>.is_functor_op,
+      unfolded cat_op_simps,
+      where lim_Obj=\<open>op_ua lim_Obj \<KK>\<close>,
+      unfolded cat_op_simps,
+      OF this,
+      simplified,
+      folded the_cf_lKe_def the_ntcf_lKe_def
+    ]
+  show ?thesis
+    by 
+      (
+        rule is_cat_rKe.is_cat_lKe_op
+          [
+            OF the_ntcf_rKe_is_cat_rKe, 
+            unfolded cat_op_simps, 
+            folded the_cf_lKe_def the_ntcf_lKe_def
+          ]
+      )
+qed
+
+
+
+subsection\<open>Preservation of Kan extensions\<close>
 
 
 text\<open>
 The following definitions are similar to the definitions that can be 
 found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
 \<close>
 
 locale is_cat_rKe_preserves =
   is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> + is_functor \<alpha> \<AA> \<DD> \<HH>
   for \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<GG> \<HH> \<epsilon> +
   assumes cat_rKe_preserves:
     "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> : (\<HH> \<circ>\<^sub>C\<^sub>F \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<HH> \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"
 
 syntax "_is_cat_rKe_preserves" :: 
   "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (
     \<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _ : _ \<mapsto>\<mapsto>\<^sub>C _)\<close> 
     [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
   )
 translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C \<DD>)" \<rightleftharpoons> 
   "CONST is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<GG> \<HH> \<epsilon>"
 
 locale is_cat_lKe_preserves =
   is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> + is_functor \<alpha> \<AA> \<DD> \<HH>
   for \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<FF> \<HH> \<eta> +
   assumes cat_lKe_preserves:
     "\<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> : \<HH> \<circ>\<^sub>C\<^sub>F \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> (\<HH> \<circ>\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"
 
 syntax "_is_cat_lKe_preserves" :: 
   "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (
     \<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _ : _ \<mapsto>\<mapsto>\<^sub>C _)\<close> 
     [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
   )
 translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>C \<DD>)" \<rightleftharpoons>
   "CONST is_cat_lKe_preserves \<alpha> \<BB> \<CC> \<AA> \<DD> \<KK> \<TT> \<FF> \<HH> \<eta>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
   assumes "\<alpha>' = \<alpha>"
     and "\<GG>' = \<GG>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<HH>' = \<HH>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
     and "\<DD>' = \<DD>"
   shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
   unfolding assms by (rule is_cat_rKe_preserves_axioms)
 
 mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
   |intro is_cat_rKe_preservesI|
   |dest is_cat_rKe_preservesD[dest]|
   |elim is_cat_rKe_preservesE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
 
 lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
   assumes "\<alpha>' = \<alpha>"
     and "\<FF>' = \<FF>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<HH>' = \<HH>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
     and "\<DD>' = \<DD>"
   shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
   unfolding assms by (rule is_cat_lKe_preserves_axioms)
 
 mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
   |intro is_cat_lKe_preservesI|
   |dest is_cat_lKe_preservesD[dest]|
   |elim is_cat_lKe_preservesE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
   "op_ntcf \<epsilon> :
     op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (op_cf \<HH> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C op_cat \<DD>)"
 proof(intro is_cat_lKe_preservesI)
   from cat_rKe_preserves show "op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<epsilon> :
     op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> (op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<GG>) \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<DD>"
     by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
       (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
 qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<GG>' = op_cf \<GG>"
     and "\<KK>' = op_cf \<KK>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
     and "\<DD>' = op_cat \<DD>"
     and "\<HH>' = op_cf \<HH>"
   shows "op_ntcf \<epsilon> :
     \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
   unfolding assms by (rule is_cat_rKe_preserves_op)
 
 lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'
 
 lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
   "op_ntcf \<eta> :
     op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (op_cf \<HH> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C op_cat \<DD>)"
 proof(intro is_cat_rKe_preservesI)
   from cat_lKe_preserves show "op_cf \<HH> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf \<eta> :
     (op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<FF>) \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<HH> \<circ>\<^sub>C\<^sub>F op_cf \<TT> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<DD>"
     by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
       (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
 qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<FF>' = op_cf \<FF>"
     and "\<KK>' = op_cf \<KK>"
     and "\<HH>' = op_cf \<HH>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
     and "\<DD>' = op_cat \<DD>"
   shows "op_ntcf \<eta> :
     \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<DD>')"
   unfolding assms by (rule is_cat_rKe_preserves_op)
 
 
 
 subsection\<open>All concepts are Kan extensions\<close>
 
 
 text\<open>
 Background information for this subsection is provided in 
 Chapter X-7 in \cite{mac_lane_categories_2010}
 and section 6.5 in \cite{riehl_category_2016}. 
 It should be noted that only the connections between the Kan extensions,
 limits and adjunctions are exposed (an alternative proof of the Yoneda
 lemma using Kan extensions is not provided in the context of this work).
 \<close>
 
 
-subsubsection\<open>Limits\<close>
+subsubsection\<open>Limits and colimits\<close>
 
 lemma cat_rKe_is_cat_limit:
   \<comment>\<open>The statement of the theorem is similar to the statement of a part of
     Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010}
     or Proposition 6.5.1 in \cite{riehl_category_2016}.\<close>
   assumes "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
 
   interpret \<epsilon>: is_cat_rKe \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<KK> \<TT> \<GG> \<epsilon> by (rule assms(1))  
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   
   from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<epsilon>.AG.HomCod.cat_in_Obj_in_Vset)
   from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<epsilon>.AG.HomCod.cat_in_Arr_in_Vset)
 
   have \<KK>_def: "\<KK> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>"
     by (rule cf_const_if_HomCod_is_cat_1) 
       (cs_concl cs_intro: cat_cs_intros)
   have \<GG>\<KK>_def: "\<GG> \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
     by
       (
         cs_concl
           cs_simp: cat_1_components(1) \<KK>_def cat_cs_simps 
           cs_intro: V_cs_intros cat_cs_intros
       )
 
   interpret \<epsilon>: is_ntcf \<alpha> \<BB> \<AA> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<TT> \<epsilon> 
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
   show "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   proof(intro is_cat_limitI is_cat_coneI)
 
     show "\<epsilon> : cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (rule \<epsilon>.ntcf_rKe.is_ntcf_axioms[unfolded \<GG>\<KK>_def])
 
     fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 
     interpret u': is_cat_cone \<alpha> r' \<BB> \<AA> \<TT> u' by (rule prems)
 
     have \<GG>_def: "\<GG> = cf_const (cat_1 \<aa> \<ff>) \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
       by (rule cf_const_if_HomDom_is_cat_1[OF \<epsilon>.Ran.is_functor_axioms])
 
     from prems have const_r': "cf_const (cat_1 \<aa> \<ff>) \<AA> r' : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
         )
 
     have cf_comp_cf_const_r_\<KK>_def: 
       "cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> r'"
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps \<KK>_def
             cs_intro: cat_cs_intros cat_lim_cs_intros
         )
 
     from \<epsilon>.cat_rKe_unique[
         OF const_r', unfolded cf_comp_cf_const_r_\<KK>_def, OF u'.is_ntcf_axioms
         ] 
     obtain \<sigma> 
       where \<sigma>: "\<sigma> : cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         and u'_def: "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
         and unique_\<sigma>: "\<And>\<sigma>'.
           \<lbrakk>
             \<sigma>' : cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>;
             u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)
           \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
       by auto
 
     interpret \<sigma>: is_ntcf \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<open>cf_const (cat_1 \<aa> \<ff>) \<AA> r'\<close> \<GG> \<sigma>
       by (rule \<sigma>)
     
     show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<and> u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
     proof(intro ex1I conjI; (elim conjE)?)
       fix f' assume prems': 
         "f' : r' \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>" "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
       from prems'(1) have "ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' :
         cf_const (cat_1 \<aa> \<ff>) \<AA> r' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         by (subst \<GG>_def) 
           (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
-      moreover then have "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
+      moreover with prems'(1) have "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps prems'(2) \<KK>_def cs_intro: cat_cs_intros
           )
       ultimately have \<sigma>_def: "\<sigma> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'"
         by (auto simp: unique_\<sigma>[symmetric])
       show "f' = \<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps \<sigma>_def cs_intro: cat_cs_intros)
     qed (cs_concl cs_simp: cat_cs_simps u'_def \<KK>_def cs_intro: cat_cs_intros)+
 
   qed (cs_concl cs_simp: \<KK>_def cs_intro: cat_cs_intros)
 
 qed
 
 lemma cat_lKe_is_cat_colimit:
   assumes "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<eta> : \<TT> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   interpret \<eta>: is_cat_lKe \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<KK> \<TT> \<FF> \<eta> by (rule assms(1))
   from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<eta>.AG.HomCod.cat_in_Obj_in_Vset)
   from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<eta>.AG.HomCod.cat_in_Arr_in_Vset)
   show ?thesis
     by 
       (
         rule is_cat_limit.is_cat_colimit_op
           [
             OF cat_rKe_is_cat_limit[
               OF 
                 \<eta>.is_cat_rKe_op[unfolded \<eta>.AG.cat_1_op[OF \<aa> \<ff>]] 
                 \<eta>.ntcf_lKe.NTDom.is_functor_op
               ], 
             unfolded cat_op_simps
           ]
       )
 qed
 
 lemma cat_limit_is_rKe:
   \<comment>\<open>The statement of the theorem is similar to the statement of a part of
     Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010} 
     or Proposition 6.5.1 in \cite{riehl_category_2016}.\<close>
   assumes "\<epsilon> : \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
     and "\<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
 proof-
 
   interpret \<epsilon>: is_cat_limit \<alpha> \<BB> \<AA> \<TT> \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>\<close> \<epsilon> by (rule assms)
   interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(2))
   interpret \<GG>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG> by (rule assms(3))
 
   show ?thesis
   proof(rule is_cat_rKeI')
 
     note \<KK>_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
     note \<GG>_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]
 
     have \<GG>\<KK>_def: "\<GG> \<circ>\<^sub>C\<^sub>F \<KK> = cf_const \<BB> \<AA> (\<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
       by (subst \<KK>_def, use nothing in \<open>subst \<GG>_def\<close>)
         (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
     show "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" 
       by (cs_concl cs_simp: cat_cs_simps \<GG>\<KK>_def cs_intro: cat_cs_intros)
 
     fix \<GG>' \<epsilon>' assume prems: 
       "\<GG>' : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       "\<epsilon>' : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 
     interpret is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG>' by (rule prems(1))
   
     note \<GG>'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]
 
     from prems(2) have \<epsilon>': 
       "\<epsilon>' : cf_const \<BB> \<AA> (\<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) \<mapsto>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       unfolding \<KK>_def 
       by (subst (asm) \<GG>'_def)
         (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     from prems(2) have "\<epsilon>' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by (intro is_cat_coneI \<epsilon>') (cs_concl cs_intro: cat_cs_intros)+
 
     from \<epsilon>.cat_lim_ua_fo[OF this] obtain f'
       where f': "f' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>"
         and \<epsilon>_def: "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f'"
         and unique_f':
           "\<lbrakk>
             f'' : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>;
             \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> f''
           \<rbrakk> \<Longrightarrow> f'' = f'"
         for f''
       by metis
 
     show "\<exists>!\<sigma>.
       \<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA> \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
     proof(intro ex1I conjI; (elim conjE)?)  
       from f' show 
         "ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         by (subst \<GG>'_def, use nothing in \<open>subst \<GG>_def\<close>) 
           (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
-      then show "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
+      with f' show "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
         by (cs_concl cs_simp: cat_cs_simps \<epsilon>_def \<KK>_def cs_intro: cat_cs_intros)
       fix \<sigma> assume prems:
         "\<sigma> : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
         "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<sigma> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)"
       interpret \<sigma>: is_ntcf \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<GG>' \<GG> \<sigma> by (rule prems(1))
       have "\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr> : \<GG>'\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       moreover have "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<AA> (\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr>)"
         by
           (
             cs_concl
               cs_simp: cat_cs_simps prems(2) \<KK>_def cs_intro: cat_cs_intros
           )
       ultimately have \<sigma>\<aa>: "\<sigma>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<rparr> = f'" by (rule unique_f')
       show "\<sigma> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'"
       proof(rule ntcf_eqI)
         from f' show 
           "ntcf_const (cat_1 \<aa> \<ff>) \<AA> f' : \<GG>' \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
           by (subst \<GG>'_def, use nothing in \<open>subst \<GG>_def\<close>)
             (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         have dom_lhs: "\<D>\<^sub>\<circ> (\<sigma>\<lparr>NTMap\<rparr>) = cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
         have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>) = cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
         show "\<sigma>\<lparr>NTMap\<rparr> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
           fix a assume prems: "a \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
           then have a_def: "a = \<aa>" unfolding cat_1_components by simp
           from f' show "\<sigma>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_const (cat_1 \<aa> \<ff>) \<AA> f'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
             unfolding a_def \<sigma>\<aa>
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         qed (auto intro: cat_cs_intros)
       qed (simp_all add: prems)
     qed
 
   qed (auto simp: assms)
 
 qed
 
 lemma cat_colimit_is_lKe:
   assumes "\<eta> : \<TT> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
     and "\<FF> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C cat_1 \<aa> \<ff> \<mapsto>\<^sub>C \<AA>"
 proof-
   interpret \<eta>: is_cat_colimit \<alpha> \<BB> \<AA> \<TT> \<open>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>\<close> \<eta>
     by (rule assms(1))
   interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(2))
   interpret \<FF>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<AA> \<FF> by (rule assms(3))
   from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
     by (auto simp: \<KK>.HomCod.cat_in_Obj_in_Vset)
   from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>" 
     by (auto simp: \<KK>.HomCod.cat_in_Arr_in_Vset)
   have \<FF>\<aa>: "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr> = op_cf \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>" unfolding cat_op_simps by simp
   note cat_1_op = \<eta>.cat_1_op[OF \<aa> \<ff>]
   show ?thesis
     by 
       (
         rule is_cat_rKe.is_cat_lKe_op
           [
             OF cat_limit_is_rKe
               [
                 OF 
                   \<eta>.is_cat_limit_op[unfolded \<FF>\<aa>]
                   \<KK>.is_functor_op[unfolded cat_1_op]
                   \<FF>.is_functor_op[unfolded cat_1_op]
               ],
             unfolded cat_op_simps cat_1_op
           ]
       )
 qed
 
 
 subsubsection\<open>Adjoints\<close>
 
 lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
   \<comment>\<open>The statement of the theorem is similar to the statement of a part of
     Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
     or Proposition 6.5.2 in \cite{riehl_category_2016}.
     The proof follows (approximately) the proof in \cite{riehl_category_2016}.\<close>
   shows "\<epsilon>\<^sub>C \<Phi> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> cf_id \<DD> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<DD>"
 proof-
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp
 
   note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF \<beta> \<alpha>\<beta> R.category_axioms]
 
   let ?\<eta> = \<open>\<eta>\<^sub>C \<Phi>\<close>
   let ?\<epsilon> = \<open>\<epsilon>\<^sub>C \<Phi>\<close>
   let ?\<DD>\<eta> = \<open>exp_cat_ntcf \<alpha> \<DD> ?\<eta>\<close>
   let ?\<DD>\<FF> = \<open>exp_cat_cf \<alpha> \<DD> \<FF>\<close>
   let ?\<DD>\<GG> = \<open>exp_cat_cf \<alpha> \<DD> \<GG>\<close>
   let ?\<DD>\<DD> = \<open>cat_FUNCT \<alpha> \<DD> \<DD>\<close>
   let ?\<CC>\<DD> = \<open>cat_FUNCT \<alpha> \<CC> \<DD>\<close>
   let ?adj_\<DD>\<eta> = \<open>cf_adjunction_of_unit \<beta> ?\<DD>\<GG> ?\<DD>\<FF> ?\<DD>\<eta>\<close>
 
   interpret \<DD>\<eta>: is_cf_adjunction \<beta> ?\<CC>\<DD> ?\<DD>\<DD> ?\<DD>\<GG> ?\<DD>\<FF> ?adj_\<DD>\<eta> by (rule exp_adj)
 
   show ?thesis
   proof(intro is_cat_rKeI)
     have id_\<DD>: "cf_map (cf_id \<DD>) \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<DD> \<DD>\<lparr>Obj\<rparr>"
       by 
         (
           cs_concl
             cs_simp: cat_FUNCT_components(1)
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     then have exp_id_\<DD>: 
       "exp_cat_cf \<alpha> \<DD> \<FF>\<lparr>ObjMap\<rparr>\<lparr>cf_map (cf_id \<DD>)\<rparr> = cf_map \<FF>"
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
         )
     have \<FF>: "cf_map \<FF> \<in>\<^sub>\<circ> cat_FUNCT \<alpha> \<CC> \<DD>\<lparr>Obj\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_FUNCT_components(1)
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     have \<epsilon>: "ntcf_arrow (\<epsilon>\<^sub>C \<Phi>) \<in>\<^sub>\<circ> ntcf_arrows \<alpha> \<DD> \<DD>"
       by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
     have \<DD>\<DD>: "category \<beta> (cat_FUNCT \<alpha> \<DD> \<DD>)"
       by (cs_concl cs_intro: cat_cs_intros)
     have \<CC>\<DD>: "category \<beta> (cat_FUNCT \<alpha> \<CC> \<DD>)"
       by (cs_concl cs_intro: cat_cs_intros)
 
     from 
       \<epsilon> \<FF> \<alpha>\<beta> id_\<DD> 
       \<DD>\<DD> \<CC>\<DD> LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
       NT.is_iso_ntcf_axioms 
     have \<epsilon>_id_\<DD>: "\<epsilon>\<^sub>C ?adj_\<DD>\<eta>\<lparr>NTMap\<rparr>\<lparr>cf_map (cf_id \<DD>)\<rparr> = ntcf_arrow ?\<epsilon>"
       by
         (
           cs_concl
             cs_simp:
               cat_Set_the_inverse[symmetric]
               cat_op_simps
               cat_cs_simps
               cat_FUNCT_cs_simps
               adj_cs_simps 
             cs_intro:
               \<DD>\<eta>.NT.iso_ntcf_is_arr_isomorphism''
               cat_op_intros
               adj_cs_intros
               cat_cs_intros
               cat_FUNCT_cs_intros
               cat_prod_cs_intros
         )      
    show "universal_arrow_fo ?\<DD>\<GG> (cf_map (cf_id \<DD>)) (cf_map \<FF>) (ntcf_arrow ?\<epsilon>)"
       by 
         (
           rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
             OF exp_adj id_\<DD>, unfolded exp_id_\<DD> \<epsilon>_id_\<DD>
             ]
         )
   qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+
 
 qed
 
 lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
   shows "\<eta>\<^sub>C \<Phi> : cf_id \<CC> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<^sub>C \<DD> \<mapsto>\<^sub>C \<CC>"
   by 
     (
       rule is_cat_rKe.is_cat_lKe_op
         [
           OF is_cf_adjunction.cf_adjunction_counit_is_rKe
             [
               OF is_cf_adjunction_op,
               folded op_ntcf_cf_adjunction_unit op_cf_cf_id
             ],
           unfolded 
             cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
         ]
     )
 
 lemma cf_adjunction_if_lKe_preserves:
   \<comment>\<open>The statement of the theorem is similar to the statement of a part of
     Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
     or Proposition 6.5.2 in \cite{riehl_category_2016}.\<close>
   assumes "\<eta> : cf_id \<DD> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C \<CC>)"
   shows "cf_adjunction_of_unit \<alpha> \<GG> \<FF> \<eta> : \<GG> \<rightleftharpoons>\<^sub>C\<^sub>F \<FF> : \<DD> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   interpret \<eta>: is_cat_lKe_preserves \<alpha> \<DD> \<CC> \<DD> \<CC> \<GG> \<open>cf_id \<DD>\<close> \<FF> \<GG> \<eta> 
     by (rule assms)
 
   from \<eta>.cat_lKe_preserves interpret \<GG>\<eta>:
     is_cat_lKe \<alpha> \<DD> \<CC> \<CC> \<GG> \<GG> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<close>
     by (cs_prems cs_simp: cat_cs_simps)
 
   from 
     \<GG>\<eta>.cat_lKe_unique
       [
         OF \<eta>.AG.HomCod.cat_cf_id_is_functor,
         unfolded \<eta>.AG.cf_cf_comp_cf_id_left,
         OF \<eta>.AG.cf_ntcf_id_is_ntcf
       ]
   obtain \<epsilon> where \<epsilon>: "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>C\<^sub>F cf_id \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and ntcf_id_\<GG>_def: "ntcf_id \<GG> = \<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)"
     by metis
   interpret \<epsilon>: is_ntcf \<alpha> \<CC> \<CC> \<open>\<GG> \<circ>\<^sub>C\<^sub>F \<FF>\<close> \<open>cf_id \<CC>\<close> \<epsilon> by (rule \<epsilon>)
   
   show ?thesis
   proof(rule counit_unit_is_cf_adjunction)
 
     show [cat_cs_simps]: "\<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>) = ntcf_id \<GG>"
       by (rule ntcf_id_\<GG>_def[symmetric])
 
     have \<eta>_def: "\<eta> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric] 
             cs_intro: cat_cs_intros
         )
     note [cat_cs_simps] = this[symmetric]
 
     let ?\<FF>\<epsilon>\<GG> = \<open>\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
     let ?\<eta>\<FF>\<GG> = \<open>\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
     let ?\<FF>\<GG>\<eta> = \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>\<close>
 
     have "(?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> = (?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
     proof(rule ntcf_eqI)
       have dom_lhs: "\<D>\<^sub>\<circ> (((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       have dom_rhs: "\<D>\<^sub>\<circ> (((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>) = \<DD>\<lparr>Obj\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
       note category.cat_Comp_assoc[cat_cs_simps del]
       show
         "((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr> =
           ((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>"
       proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
         fix a assume "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
         then show
           "((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr> =
             ((?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<FF>\<GG>\<eta>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>)\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by
             (
               cs_concl 
                 cs_simp: cat_cs_simps \<eta>.ntcf_lKe.ntcf_Comp_commute[symmetric]
                 cs_intro: cat_cs_intros
             )
       qed (cs_concl cs_intro: cat_cs_intros)+
     qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
     also have "\<dots> = (ntcf_id \<FF> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
       by
         (
           cs_concl
             cs_simp:
               cat_cs_simps
               cf_comp_cf_ntcf_comp_assoc
               cf_ntcf_comp_ntcf_cf_comp_assoc
               cf_ntcf_comp_ntcf_vcomp[symmetric]
             cs_intro: cat_cs_intros
         )
     also have "\<dots> = \<eta>" by (cs_concl cs_simp: cat_cs_simps)
     finally have "(?\<FF>\<epsilon>\<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<eta>\<FF>\<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> = \<eta>" by simp
     then have \<eta>_def':
       "\<eta> = (\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta>"
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric] 
             cs_intro: cat_cs_intros
         )+
   
     have \<FF>\<epsilon>\<eta>\<FF>:
       "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
     from \<eta>.cat_lKe_unique[OF \<eta>.Lan.is_functor_axioms \<eta>.ntcf_lKe.is_ntcf_axioms]
     obtain \<sigma> where
-      "\<lbrakk> \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>; \<eta> = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> \<rbrakk> \<Longrightarrow> 
-        \<sigma>' = \<sigma>"
+      "\<lbrakk> \<sigma>' : \<FF> \<mapsto>\<^sub>C\<^sub>F \<FF> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>; \<eta> = \<sigma>' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<eta> \<rbrakk> \<Longrightarrow> \<sigma>' = \<sigma>"
       for \<sigma>'
       by metis
   
     from this[OF \<eta>.Lan.cf_ntcf_id_is_ntcf \<eta>_def] this[OF \<FF>\<epsilon>\<eta>\<FF> \<eta>_def'] show
       "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (\<eta> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<FF>) = ntcf_id \<FF>"
       by simp
 
   qed (cs_concl cs_intro: cat_cs_intros)+
 
 qed
 
 lemma cf_adjunction_if_rKe_preserves:
   assumes "\<epsilon> : \<FF> \<circ>\<^sub>C\<^sub>F \<GG> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> cf_id \<DD> : \<DD> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<GG> : \<DD> \<mapsto>\<mapsto>\<^sub>C \<CC>)"
   shows "cf_adjunction_of_counit \<alpha> \<FF> \<GG> \<epsilon> : \<FF> \<rightleftharpoons>\<^sub>C\<^sub>F \<GG> : \<CC> \<rightleftharpoons>\<rightleftharpoons>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
 proof-
   interpret \<epsilon>: is_cat_rKe_preserves \<alpha> \<DD> \<CC> \<DD> \<CC> \<GG> \<open>cf_id \<DD>\<close> \<FF> \<GG> \<epsilon> 
     by (rule assms)
   have "op_cf (cf_id \<DD>) = cf_id (op_cat \<DD>)" unfolding cat_op_simps by simp
   show ?thesis
     by 
       (
         rule is_cf_adjunction.is_cf_adjunction_op
           [
             OF cf_adjunction_if_lKe_preserves[
               OF \<epsilon>.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
               ], 
             folded cf_adjunction_of_counit_def, 
             unfolded cat_op_simps
           ]
       )
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_Limit.thy
@@ -1,3706 +1,3785 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Limits\<close>
 theory CZH_UCAT_Limit
   imports 
     CZH_UCAT_Universal
     CZH_Elementary_Categories.CZH_ECAT_Discrete 
     CZH_Elementary_Categories.CZH_ECAT_SS
     CZH_Elementary_Categories.CZH_ECAT_Parallel
 begin
 
 
 
 subsection\<open>Background\<close>
 
 named_theorems cat_lim_cs_simps
 named_theorems cat_lim_cs_intros
 
 
 
 subsection\<open>Cone and cocone\<close>
 
 
 text\<open>
 In the context of this work, the concept of a cone corresponds to that of a cone
 to the base of a functor from a vertex, as defined in Chapter III-4 in
 \cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
 of a cone from the base of a functor to a vertex, as defined in Chapter III-3
 in \cite{mac_lane_categories_2010}.
 \<close>
 
 locale is_cat_cone = is_ntcf \<alpha> \<JJ> \<CC> \<open>cf_const \<JJ> \<CC> c\<close> \<FF> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
   assumes cat_cone_obj[cat_lim_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 
 syntax "_is_cat_cone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_cone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
 
 locale is_cat_cocone = is_ntcf \<alpha> \<JJ> \<CC> \<FF> \<open>cf_const \<JJ> \<CC> c\<close> \<NN> for \<alpha> c \<JJ> \<CC> \<FF> \<NN> +
   assumes cat_cocone_obj[cat_lim_cs_intros]: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 
 syntax "_is_cat_cocone" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_cocone \<alpha> c \<JJ> \<CC> \<FF> \<NN>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "\<NN> : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_cone_axioms)
 
 mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
   |intro is_cat_coneI|
   |dest is_cat_coneD[dest!]|
   |elim is_cat_coneE[elim!]|
 
 lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
   assumes "c' = cf_const \<JJ> \<CC> c"
   shows "\<NN> : c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   unfolding assms by (cs_concl cs_intro: cat_cs_intros)
 
 lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'
 
 lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "c' = c" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "\<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_cocone_axioms)
 
 mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
   |intro is_cat_coconeI|
   |dest is_cat_coconeD[dest!]|
   |elim is_cat_coconeE[elim!]|
 
 lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
   assumes "c' = cf_const \<JJ> \<CC> c"
   shows "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   unfolding assms by (cs_concl cs_intro: cat_cs_intros)
 
 lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_cone) is_cat_cocone_op:
   "op_ntcf \<NN> : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_coconeI)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)+
 
 lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
   shows "op_ntcf \<NN> : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_cocone_op)
 
 lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'
 
 lemma (in is_cat_cocone) is_cat_cone_op:
   "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_coneI)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)
 
 lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
   assumes "\<alpha>' = \<alpha>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>" and "\<FF>' = op_cf \<FF>"
   shows "op_ntcf \<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_cone_op)
 
 lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_cat_cone) cat_cone_LArr_app_is_arr: 
   assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
 proof-
   from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
     by (cs_concl cs_simp: cat_cs_simps)
   from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
 qed
 
 lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]: 
   assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : c \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>j"
   using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)
 
 lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'
 
 lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr: 
   assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> c"
 proof-
   from assms have [simp]: "cf_const \<JJ> \<CC> c\<lparr>ObjMap\<rparr>\<lparr>j\<rparr> = c"
     by (cs_concl cs_simp: cat_cs_simps)
   from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
 qed
 
 lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]: 
   assumes "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" and "\<FF>j = \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : \<FF>j \<mapsto>\<^bsub>\<CC>\<^esub> c"
   using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)
 
 lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'
 
 lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
   assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
   shows "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
   using ntcf_Comp_commute[symmetric, OF assms] assms 
   by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute
 
 lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
   assumes "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"
   shows "\<NN>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
   using ntcf_Comp_commute[OF assms] assms 
   by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
 lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute
 
 
 text\<open>Utilities/helper lemmas.\<close>
 
 lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
   assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c" 
     and "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'" 
     and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
   shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
 proof-
   from assms(3) have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
     by simp
   from this assms(1,2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
     by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 qed
 
 lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
   assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c" 
     and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" 
   shows "\<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
 proof-
   interpret \<NN>': is_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
   show ?thesis
   proof(rule ntcf_eqI[OF \<NN>'.is_ntcf_axioms])
     from assms(2) show 
       "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' : cf_const \<JJ> \<CC> c' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     show "\<NN>'\<lparr>NTMap\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI, unfold cat_cs_simps)
       show "vsv ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
         by (cs_concl cs_intro: cat_cs_intros)
       from assms show "\<JJ>\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>)"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       fix j assume prems': "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
       with assms(1,2) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
     qed auto
   qed simp_all
 qed
 
 lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
   assumes "\<NN>' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> \<NN>' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<longleftrightarrow>
     f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
   using 
     helper_cat_cone_ntcf_vcomp_Comp[OF assms]
     helper_cat_cone_Comp_ntcf_vcomp[OF assms]
   by (intro iffI; elim conjE; intro conjI) metis+
 
 lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
   assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'" 
     and "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>" 
     and "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
   shows "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
 proof-
   interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
   from assms(3) have "op_ntcf \<NN>' = op_ntcf (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)" by simp
   from this assms(2) have op_\<NN>':
     "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
   have "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
     by 
       (
         rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
           OF is_cat_cone_op \<NN>'.is_cat_cone_op, 
           unfolded cat_op_simps, 
           OF assms(2) op_\<NN>' assms(4)
           ]
       )
   from this assms(2,4) show "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
     by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
 qed
 
 lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
   assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'" 
     and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" 
   shows "\<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
 proof-
   interpret \<NN>': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> \<NN>' by (rule assms(1))
   from assms(2) have \<NN>'j: "\<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
     if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
     using that
     unfolding assms(3)[OF that] 
     by (cs_concl cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros)
   have op_\<NN>': 
     "op_ntcf \<NN>' = op_ntcf \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
     by 
       (
         rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
           OF is_cat_cone_op \<NN>'.is_cat_cone_op,
           unfolded cat_op_simps, 
           OF assms(2) \<NN>'j, 
           simplified
           ]
       )
   from assms(2) show "\<NN>' = (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>)"
     by 
       (
         cs_concl 
           cs_simp: 
             cat_op_simps op_\<NN>' eq_op_ntcf_iff[symmetric, OF \<NN>'.is_ntcf_axioms]
           cs_intro: cat_cs_intros
       )
 qed
 
 lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
   assumes "\<NN>' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> \<NN>' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> \<longleftrightarrow>
     f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<NN>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<NN>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
   using 
     helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
     helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
   by (intro iffI; elim conjE; intro conjI) metis+
 
 
 
 subsection\<open>Limit and colimit\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The concept of a limit is introduced in Chapter III-4 in
 \cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
 Chapter III-3 in \cite{mac_lane_categories_2010}.
 \<close>
 
 locale is_cat_limit = is_cat_cone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u + 
   assumes cat_lim_ua_fo: "\<And>u' r'. u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
     \<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
 
 syntax "_is_cat_limit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u"
 
 locale is_cat_colimit = is_cat_cocone \<alpha> r \<JJ> \<CC> \<FF> u for \<alpha> \<JJ> \<CC> \<FF> r u +
   assumes cat_colim_ua_of: "\<And>u' r'. u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
     \<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
 
 syntax "_is_cat_colimit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "u : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_limit_axioms)
 
 mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
   |intro is_cat_limitI|
   |dest is_cat_limitD[dest]|
   |elim is_cat_limitE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_limitD(1)
 
 lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_colimit_axioms)
 
 mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
   |intro is_cat_colimitI|
   |dest is_cat_colimitD[dest]|
   |elim is_cat_colimitE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)
 
 
 text\<open>Limits, colimits and universal arrows.\<close>
 
 lemma (in is_cat_limit) cat_lim_is_universal_arrow_fo:
   "universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
 proof(intro is_functor.universal_arrow_foI)
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
 
   show "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
     by 
       (
         intro 
           \<beta> \<alpha>\<beta>
           cf_diagonal_is_functor 
           NTDom.HomDom.category_axioms 
           NTDom.HomCod.category_axioms
       )
 
   show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cone_obj)
   then show "ntcf_arrow u : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
 
   fix r' u' assume prems: 
     "r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
   from prems(1) have [cat_cs_simps]: 
     "cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
     "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
     by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
   from prems(2,1) have
     "u' : cf_map (cf_const \<JJ> \<CC> r') \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
     by (cs_prems cs_simp: cat_cs_simps)
   note u'[unfolded cat_cs_simps] = cat_FUNCT_is_arrD[OF this]
 
   from cat_lim_ua_fo[OF is_cat_coneI[OF u'(1) prems(1)]] obtain f 
     where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
       and [symmetric, cat_cs_simps]: 
         "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
       and f_unique: 
         "\<lbrakk>
           f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r;
           ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'
          \<rbrakk> \<Longrightarrow> f' = f"
     for f'
     by metis
 
   show "\<exists>!f'.
     f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and>
     u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
   proof(intro ex1I conjI; (elim conjE)?)
     show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
     with \<alpha>\<beta> cat_cone_obj show u'_def: 
       "u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps 
             cs_intro:  cat_cs_intros cat_FUNCT_cs_intros
         )
     fix f' assume prems': 
       "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
       "u' = umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
     from prems'(2) \<alpha>\<beta> f prems' cat_cone_obj have u'_def':
       "u' = ntcf_arrow (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f')"
       by
         (
           cs_prems 
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
       by (cs_concl cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros)
     from f_unique[OF prems'(1) this] show "f' = f" .
 
   qed
 
 qed
 
 lemma (in is_cat_cone) cat_cone_is_cat_limit:
   assumes "universal_arrow_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
   shows "\<NN> : c <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
 
   show ?thesis
   proof(intro is_cat_limitI is_cat_cone_axioms)
     fix u' c' assume prems: "u' : c' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 
     interpret u': is_cat_cone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)
 
     from u'.cat_cone_obj have u'_is_arr:
       "ntcf_arrow u' : \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map \<FF>"
       by 
         (
           cs_concl
             cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     
     from is_functor.universal_arrow_foD(3)
       [
         OF
           cf_diagonal_is_functor[
             OF \<beta> \<alpha>\<beta> NTDom.HomDom.category_axioms NTDom.HomCod.category_axioms
             ]
           assms
           u'.cat_cone_obj
           u'_is_arr
       ]
     obtain f where f: "f : c' \<mapsto>\<^bsub>\<CC>\<^esub> c"
       and u'_def': "ntcf_arrow u' =
         umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
       and f'_unique:
         "\<lbrakk>
           f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c;
           ntcf_arrow u' =
             umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
          \<rbrakk> \<Longrightarrow> f' = f"
       for f'
       by metis
 
     from u'_def' \<alpha>\<beta> f cat_cone_obj have u'_def: 
       "u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
       by
         (
           cs_prems
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     
     show "\<exists>!f'. f' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c \<and> u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
     proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
       fix f'' assume prems': 
         "f'' : c' \<mapsto>\<^bsub>\<CC>\<^esub> c" "u' = \<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f''"
       from \<alpha>\<beta> prems' have 
         "ntcf_arrow u' = 
           umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
               cs_intro: cat_cs_intros cat_FUNCT_cs_intros
           )
       from f'_unique[OF prems'(1) this] show "f'' = f".
     qed
 
   qed
   
 qed
 
 lemma (in is_cat_colimit) cat_colim_is_universal_arrow_of:
   "universal_arrow_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u)"
 proof(intro is_functor.universal_arrow_ofI)
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
 
   show "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
     by 
       (
         intro 
           \<beta> \<alpha>\<beta>
           cf_diagonal_is_functor 
           NTDom.HomDom.category_axioms 
           NTDom.HomCod.category_axioms
       )
 
   show "r \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro cat_cocone_obj)
 
   then show "ntcf_arrow u : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r\<rparr>"
     by 
       (
         cs_concl 
           cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
 
   fix r' u' assume prems: 
     "r' \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" "u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>r'\<rparr>"
   from prems(1) have [cat_cs_simps]: 
     "cf_of_cf_map \<JJ> \<CC> (cf_map \<FF>) = \<FF>"
     "cf_of_cf_map \<JJ> \<CC> (cf_map (cf_const \<JJ> \<CC> r')) = cf_const \<JJ> \<CC> r'"
     by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
   from prems(2,1) have
     "u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> cf_map (cf_const \<JJ> \<CC> r')"
     by (cs_prems cs_simp: cat_cs_simps)
   note u'[unfolded cat_cs_simps] = cat_FUNCT_is_arrD[OF this]
 
   from cat_colim_ua_of[OF is_cat_coconeI[OF u'(1) prems(1)]] obtain f 
     where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
       and [symmetric, cat_cs_simps]: 
         "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
       and f_unique: 
         "\<lbrakk>
           f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r';
           ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u
          \<rbrakk> \<Longrightarrow> f' = f"
     for f'
     by metis
 
   show " \<exists>!f'. 
     f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> 
     u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
   proof(intro ex1I conjI; (elim conjE)?)
   
     show "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by (rule f)
     with \<alpha>\<beta> cat_cocone_obj show u'_def: 
       "u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: u'(2)[symmetric] cat_cs_simps cat_FUNCT_cs_simps 
             cs_intro:  cat_cs_intros cat_FUNCT_cs_intros
         )
   
     fix f' assume prems':
       "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
       "u' = umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>"
     from prems'(2) \<alpha>\<beta> f prems' cat_cocone_obj have u'_def':
       "u' = ntcf_arrow (ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
       by
         (
           cs_prems
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     from prems'(1) have "ntcf_of_ntcf_arrow \<JJ> \<CC> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
       by (cs_concl cs_simp: cat_FUNCT_cs_simps u'_def' cs_intro: cat_cs_intros)
     from f_unique[OF prems'(1) this] show "f' = f" .
 
   qed
 
 qed
 
 lemma (in is_cat_cocone) cat_cocone_is_cat_colimit:
   assumes "universal_arrow_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>)"
   shows "\<NN> : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m c : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def \<Z>_Limit_\<alpha>\<omega> \<Z>_\<omega>_\<alpha>\<omega> \<Z>_def \<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
 
   show ?thesis
   proof(intro is_cat_colimitI is_cat_cocone_axioms)
   
     fix u' c' assume prems: "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e c' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 
     interpret u': is_cat_cocone \<alpha> c' \<JJ> \<CC> \<FF> u' by (rule prems)
 
     from u'.cat_cocone_obj have u'_is_arr:
       "ntcf_arrow u' : cf_map \<FF> \<mapsto>\<^bsub>cat_FUNCT \<alpha> \<JJ> \<CC>\<^esub> \<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<lparr>ObjMap\<rparr>\<lparr>c'\<rparr>"
       by
         (
           cs_concl 
             cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
 
     from is_functor.universal_arrow_ofD(3)
       [
         OF
           cf_diagonal_is_functor[
             OF \<beta> \<alpha>\<beta> NTDom.HomDom.category_axioms NTDom.HomCod.category_axioms
             ]
           assms
           u'.cat_cocone_obj
           u'_is_arr
       ]
     obtain f where f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> c'"
       and u'_def': "ntcf_arrow u' =
         umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
       and f'_unique:
         "\<lbrakk>
           f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c';
           ntcf_arrow u' =
             umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f'\<rparr>
          \<rbrakk> \<Longrightarrow> f' = f"
       for f'
       by metis
 
     from u'_def' \<alpha>\<beta> f cat_cocone_obj have u'_def: 
       "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
       by
         (
           cs_prems
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
     
     show "\<exists>!f'. f' : c \<mapsto>\<^bsub>\<CC>\<^esub> c' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
     proof(intro ex1I conjI; (elim conjE)?, (rule f)?, (rule u'_def)?)
       fix f'' assume prems': 
         "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> c'" "u' = ntcf_const \<JJ> \<CC> f'' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>"
       from \<alpha>\<beta> prems' have 
         "ntcf_arrow u' = 
           umap_of (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) c (ntcf_arrow \<NN>) c'\<lparr>ArrVal\<rparr>\<lparr>f''\<rparr>"
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_FUNCT_cs_simps
               cs_intro: cat_cs_intros cat_FUNCT_cs_intros
           )
       from f'_unique[OF prems'(1) this] show "f'' = f".
     qed
 
   qed
   
 qed
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_limit) is_cat_colimit_op:
   "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
 proof(intro is_cat_colimitI)
   show "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     by (cs_concl cs_simp: cs_intro: cat_op_intros)
   fix u' r' assume prems: 
     "u' : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   interpret u': is_cat_cocone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u' 
     by (rule prems)
   from cat_lim_ua_fo[OF u'.is_cat_cone_op[unfolded cat_op_simps]] obtain f 
     where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
       and op_u'_def: "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
       and f_unique: 
         "\<lbrakk> f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r; op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f' \<rbrakk> \<Longrightarrow>
           f' = f"
     for f'
     by metis
   from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f)"
     by simp
   from this f have u'_def: 
     "u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
   show "\<exists>!f'. 
     f' : r \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r' \<and> 
     u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
   proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
     fix f' assume prems': 
       "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
       "u' = ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u"
     from prems'(2) have 
       "op_ntcf u' = op_ntcf (ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf u)"
       by simp
     from this prems'(1) have "op_ntcf u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
       by 
         (
           cs_prems
             cs_simp: cat_cs_simps cat_op_simps 
             cs_intro: cat_cs_intros cat_op_intros
         )
     from f_unique[OF prems'(1) this] show "f' = f". 
   qed (intro u'_def f)+
 qed
 
 lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
   assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_colimit_op)
 
 lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'
 
 lemma (in is_cat_colimit) is_cat_limit_op:
   "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
 proof(intro is_cat_limitI)
   show "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     by (cs_concl cs_simp: cs_intro: cat_op_intros)
   fix u' r' assume prems: 
     "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   interpret u': is_cat_cone \<alpha> r' \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> u' 
     by (rule prems)
   from cat_colim_ua_of[OF u'.is_cat_cocone_op[unfolded cat_op_simps]] obtain f 
     where f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
       and op_u'_def: "op_ntcf u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
       and f_unique: 
         "\<lbrakk> f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'; op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u \<rbrakk> \<Longrightarrow>
           f' = f"
     for f'
     by metis
   from op_u'_def have "op_ntcf (op_ntcf u') = op_ntcf (ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u)"
     by simp
   from this f have u'_def: 
     "u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
     by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
   show "\<exists>!f'. 
     f' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r \<and> 
     u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
   proof(intro ex1I conjI; (elim conjE)?, (unfold cat_op_simps)?)
     fix f' assume prems': 
       "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'"
       "u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f'"
     from prems'(2) have 
       "op_ntcf u' = op_ntcf (op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f')"
       by simp
     from this prems'(1) have "op_ntcf u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
       by 
         (
           cs_prems
             cs_simp: cat_cs_simps cat_op_simps 
             cs_intro: cat_cs_intros cat_op_intros
         )
     from f_unique[OF prems'(1) this] show "f' = f". 
   qed (intro u'_def f)+
 qed
 
 lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
   assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_limit_op)
 
 lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'
 
 
 subsubsection\<open>Universal property\<close>
 
 lemma (in is_cat_limit) cat_lim_unique_cone':
   assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows 
     "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
   by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
     (intro cat_lim_ua_fo assms)
 
 lemma (in is_cat_limit) cat_lim_unique:
   assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
   by (intro cat_lim_ua_fo[OF is_cat_limitD(1)[OF assms]])
 
 lemma (in is_cat_limit) cat_lim_unique':
   assumes "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows 
     "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
   by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])
 
 lemma (in is_cat_colimit) cat_colim_unique_cocone:
   assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
 proof-
   interpret u': is_cat_cocone \<alpha> r' \<JJ> \<CC> \<FF> u' by (rule assms(1))
   from u'.cat_cocone_obj have op_r': "r' \<in>\<^sub>\<circ> op_cat \<CC>\<lparr>Obj\<rparr>"
     unfolding cat_op_simps by simp
   from 
     is_cat_limit.cat_lim_ua_fo[
       OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
       ]
   obtain f' where f': "f' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r"
     and [cat_cs_simps]: 
       "op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f')"
     and unique: 
       "\<lbrakk>
         f'' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r;
         op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f'')
        \<rbrakk> \<Longrightarrow> f'' = f'" 
     for f''
     by metis
   show ?thesis
   proof(intro ex1I conjI; (elim conjE)?)
     from f' show f': "f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" unfolding cat_op_simps by simp
     show "u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
       by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
         (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
     fix f'' assume prems: "f'' : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" "u' = ntcf_const \<JJ> \<CC> f'' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
     from prems(1) have "f'' : r' \<mapsto>\<^bsub>op_cat \<CC>\<^esub> r" unfolding cat_op_simps by simp
     moreover from prems(1) have 
       "op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F op_ntcf (ntcf_const \<JJ> \<CC> f'')"
       unfolding prems(2)
       by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
     ultimately show "f'' = f'" by (rule unique)
   qed
 qed
 
 lemma (in is_cat_colimit) cat_colim_unique_cocone':
   assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows 
     "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
   by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
     (intro cat_colim_unique_cocone assms)
 
 lemma (in is_cat_colimit) cat_colim_unique:
   assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> u' = ntcf_const \<JJ> \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
   by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])
 
 lemma (in is_cat_colimit) cat_colim_unique':
   assumes "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows
     "\<exists>!f'. f' : r \<mapsto>\<^bsub>\<CC>\<^esub> r' \<and> (\<forall>j\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
 proof-
   interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(1))
   show ?thesis
     by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
       (intro cat_colim_unique assms)
 qed
 
 lemma cat_lim_ex_is_arr_isomorphism:
   assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" and "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
 proof-
   interpret u: is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
   interpret u': is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     by (simp_all add: \<beta>_def u.\<Z>_Limit_\<alpha>\<omega> u.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def u.\<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
   have \<Delta>: "\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC> : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_FUNCT \<alpha> \<JJ> \<CC>"
     by 
       (
         intro 
           \<beta> \<alpha>\<beta>
           cf_diagonal_is_functor 
           u.NTDom.HomDom.category_axioms 
           u.NTDom.HomCod.category_axioms
       )
   then interpret \<Delta>: is_functor \<beta> \<CC> \<open>cat_FUNCT \<alpha> \<JJ> \<CC>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>\<close> by simp
   from is_functor.cf_universal_arrow_fo_ex_is_arr_isomorphism[
     OF \<Delta> u.cat_lim_is_universal_arrow_fo u'.cat_lim_is_universal_arrow_fo
     ]
   obtain f where f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r"
     and u': "ntcf_arrow u' =
     umap_fo (\<Delta>\<^sub>C\<^sub>F \<alpha> \<JJ> \<CC>) (cf_map \<FF>) r (ntcf_arrow u) r'\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
     by auto
   from f have "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
   from u' this have "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
     by
       (
         cs_prems 
           cs_simp: cat_cs_simps cat_FUNCT_cs_simps
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
   with f that show ?thesis by simp
 qed
 
 lemma cat_lim_ex_is_arr_isomorphism':
   assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" 
     and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   interpret u: is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
   interpret u': is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
   from assms obtain f 
     where iso_f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r" and u'_def: "u' = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f"
     by (rule cat_lim_ex_is_arr_isomorphism)
   then have f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by auto
   then have "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
     by 
       (
         intro u.helper_cat_cone_ntcf_vcomp_Comp[
           OF u'.is_cat_cone_axioms f u'_def that
           ]
       )
   with iso_f that show ?thesis by simp
 qed
 
 lemma cat_colim_ex_is_arr_isomorphism:
   assumes "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" and "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
 proof-
   interpret u: is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
   interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
   obtain f where f: "f : r' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>op_cat \<CC>\<^esub> r"
     and [cat_cs_simps]: 
       "op_ntcf u' = op_ntcf u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (op_cat \<JJ>) (op_cat \<CC>) f"
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism[
           OF u.is_cat_limit_op u'.is_cat_limit_op
           ]
       )
   from f have iso_f: "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" unfolding cat_op_simps by simp
   then have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by auto
   have "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
     by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
       (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
   from iso_f this that show ?thesis by simp
 qed
 
 lemma cat_colim_ex_is_arr_isomorphism':
   assumes "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "u' : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r' : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'"
     and "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr> \<Longrightarrow> u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
 proof-
   interpret u: is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u by (rule assms(1))
   interpret u': is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r' u' by (rule assms(2))
   from assms obtain f 
     where iso_f: "f : r \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> r'" and u'_def: "u' = ntcf_const \<JJ> \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F u"
     by (rule cat_colim_ex_is_arr_isomorphism)
   then have f: "f : r \<mapsto>\<^bsub>\<CC>\<^esub> r'" by auto
   then have "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> u\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
     by 
       (
         intro u.helper_cat_cocone_ntcf_vcomp_Comp[
           OF u'.is_cat_cocone_axioms f u'_def that
           ]
       )
   with iso_f that show ?thesis by simp
 qed
 
 
+subsubsection\<open>Further properties\<close>
+
+lemma ntcf_cf_comp_is_cat_limit_if_is_iso_functor:
+  assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
+  shows "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+proof(intro is_cat_limitI)
+  interpret u: is_cat_limit \<alpha> \<BB> \<CC> \<FF> r u by (rule assms(1)) 
+  interpret \<GG>: is_iso_functor \<alpha> \<AA> \<BB> \<GG> by (rule assms(2))
+  note [cf_cs_simps] = is_iso_functor_is_arr_isomorphism(2,3)
+  show u\<GG>: "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>D\<^sub>G\<^sub>H\<^sub>M \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (intro is_cat_coneI)
+      (
+        cs_concl 
+          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
+      )
+  fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> \<circ>\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  then interpret u': is_cat_cone \<alpha> r' \<AA> \<CC> \<open>\<FF> \<circ>\<^sub>C\<^sub>F \<GG>\<close> u' by simp
+  have "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    by (intro is_cat_coneI)
+      (
+        cs_concl
+          cs_simp: cat_cs_simps cf_cs_simps
+          cs_intro: cat_cs_intros cat_lim_cs_intros cf_cs_intros
+      )
+  from is_cat_limit.cat_lim_ua_fo[OF assms(1) this] obtain f 
+    where f: "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r"
+      and u'_\<GG>: "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f"
+      and f'f:
+        "\<lbrakk>
+          f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r; 
+          u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f' 
+         \<rbrakk> \<Longrightarrow> f' = f"
+    for f'
+    by metis
+  from u'_\<GG> have u'_inv\<GG>_\<GG>:
+    "(u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> = (u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>"
+    by simp
+  show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r \<and> u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f'"
+  proof(intro ex1I conjI; (elim conjE)?)
+    show "f : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" by (rule f)
+    from u'_inv\<GG>_\<GG> f show "u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f"
+      by
+        (
+          cs_prems
+            cs_simp:
+              cf_cs_simps cat_cs_simps
+              ntcf_cf_comp_ntcf_cf_comp_assoc 
+              ntcf_vcomp_ntcf_cf_comp[symmetric]
+            cs_intro: cat_cs_intros cf_cs_intros
+        )
+    fix f' assume prems:
+      "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> r" "u' = u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f'"
+    from prems(2) have 
+      "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = 
+        (u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<AA> \<CC> f') \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG>"
+      by simp
+    from this f prems(1) have "u' \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F inv_cf \<GG> = u \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<BB> \<CC> f'"
+      by
+        (
+          cs_prems
+            cs_simp:
+              cat_cs_simps cf_cs_simps
+              ntcf_vcomp_ntcf_cf_comp[symmetric]
+              ntcf_cf_comp_ntcf_cf_comp_assoc
+            cs_intro: cf_cs_intros cat_cs_intros
+        )
+    then show "f' = f" by (intro f'f prems(1))
+  qed
+qed
+
+lemma ntcf_cf_comp_is_cat_limit_if_is_iso_functor'[cat_lim_cs_intros]:
+  assumes "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
+    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<alpha>\<^esub> \<BB>"
+    and "\<AA>' = \<FF> \<circ>\<^sub>C\<^sub>F \<GG>"
+  shows "u \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG> : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<AA>' : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+  using assms(1,2) 
+  unfolding assms(3)
+  by (rule ntcf_cf_comp_is_cat_limit_if_is_iso_functor)
+
+
 
 subsection\<open>Finite limit and finite colimit\<close>
 
 locale is_cat_finite_limit = is_cat_limit \<alpha> \<JJ> \<CC> \<FF> r u + finite_category \<alpha> \<JJ>
   for \<alpha> \<JJ> \<CC> \<FF> r u
 
 syntax "_is_cat_finite_limit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_finite_limit \<alpha> \<JJ> \<CC> \<FF> r u"
 
 locale is_cat_finite_colimit = is_cat_colimit \<alpha> \<JJ> \<CC> \<FF> r u + finite_category \<alpha> \<JJ>
   for \<alpha> \<JJ> \<CC> \<FF> r u
 
 syntax "_is_cat_finite_colimit" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_finite_colimit \<alpha> \<JJ> \<CC> \<FF> r u"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "u : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_limit_axioms)
 
 mk_ide rf is_cat_finite_limit_def
   |intro is_cat_finite_limitI|
   |dest is_cat_finite_limitD[dest]|
   |elim is_cat_finite_limitE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_finite_limitD
 
 lemma (in is_cat_finite_colimit) 
   is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "r' = r" and "\<JJ>' = \<JJ>" and "\<CC>' = \<CC>" and "\<FF>' = \<FF>"
   shows "u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_colimit_axioms)
 
 mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
   |intro is_cat_finite_colimitI|
   |dest is_cat_finite_colimitD[dest]|
   |elim is_cat_finite_colimitE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
   "op_ntcf u : op_cf \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by 
     (
       cs_concl cs_intro:
         is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
     )
 
 lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
   assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf u : \<FF>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n r : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_colimit_op)
 
 lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'
 
 lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
   "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by 
     (
       cs_concl cs_intro: 
         is_cat_finite_limitI cat_op_intros cat_small_cs_intros
     )
 
 lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
   assumes "\<FF>' = op_cf \<FF>" and "\<JJ>' = op_cat \<JJ>" and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m\<^sub>.\<^sub>f\<^sub>i\<^sub>n \<FF>' : \<JJ>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_limit_op)
 
 lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'
 
 
 
 subsection\<open>Product and coproduct\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The definition of the product object is a specialization of the 
 definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
 In the definition presented below, the discrete category that is used in the 
 definition presented in \cite{mac_lane_categories_2010} is parameterized by
 an index set and the functor from the discrete category is 
 parameterized by a function from the index set to the set of 
 the objects of the category.
 \<close>
 
 locale is_cat_obj_prod = 
   is_cat_limit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> P \<pi> + cf_discrete \<alpha> I A \<CC>
   for \<alpha> I A \<CC> P \<pi>
 
 syntax "_is_cat_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_obj_prod \<alpha> I A \<CC> P \<pi>"
 
 locale is_cat_obj_coprod = 
   is_cat_colimit \<alpha> \<open>:\<^sub>C I\<close> \<CC> \<open>:\<rightarrow>: I A \<CC>\<close> U \<pi> + cf_discrete \<alpha> I A \<CC>
   for \<alpha> I A \<CC> U \<pi>
 
 syntax "_is_cat_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_obj_coprod \<alpha> I A \<CC> U \<pi>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>" 
   shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_prod_axioms)
 
 mk_ide rf is_cat_obj_prod_def
   |intro is_cat_obj_prodI|
   |dest is_cat_obj_prodD[dest]|
   |elim is_cat_obj_prodE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_prodD
 
 lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>" 
   shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_coprod_axioms)
 
 mk_ide rf is_cat_obj_coprod_def
   |intro is_cat_obj_coprodI|
   |dest is_cat_obj_coprodD[dest]|
   |elim is_cat_obj_coprodE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
   "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   using cf_discrete_vdomain_vsubset_Vset
   by (intro is_cat_obj_coprodI)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
 
 lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_coprod_op)
 
 lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'
 
 lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
   "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   using cf_discrete_vdomain_vsubset_Vset
   by (intro is_cat_obj_prodI)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
 
 lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_prod_op)
 
 lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'
 
 
 subsubsection\<open>Universal property\<close>
 
-(*cat_obj_prod_unique_cone already proven*)
 lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I A \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
   by 
     (
       rule cat_lim_unique_cone'[
         OF assms, unfolded the_cat_discrete_components(1)
         ]
     )
 
 lemma (in is_cat_obj_prod) cat_obj_prod_unique:
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
   by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])
 
 lemma (in is_cat_obj_prod) cat_obj_prod_unique':
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> (\<forall>i\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')"
 proof-
   interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(1))
   show ?thesis
     by 
       (
         rule cat_lim_unique'[
           OF \<pi>'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
           ]
       )
 qed
 
 lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
   assumes "\<pi>' : :\<rightarrow>: I A \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e U' : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
   by 
     (
       rule cat_colim_unique_cocone'[
         OF assms, unfolded the_cat_discrete_components(1)
         ]
     )
 
 lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
   assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> \<pi>' = ntcf_const (:\<^sub>C I) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
   by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])
 
 lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
   assumes "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : U \<mapsto>\<^bsub>\<CC>\<^esub> U' \<and> (\<forall>j\<in>\<^sub>\<circ>I. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>)"
   by 
     (
       rule cat_colim_unique'[
         OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
         ]
     )
 
 lemma cat_obj_prod_ex_is_arr_isomorphism:
   assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f"
 proof-
   interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism[
           OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms
           ]
       )
 qed
 
 lemma cat_obj_prod_ex_is_arr_isomorphism':
   assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" 
     and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   interpret \<pi>: is_cat_obj_prod \<alpha> I A \<CC> P \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_prod \<alpha> I A \<CC> P' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism'[
           OF \<pi>.is_cat_limit_axioms \<pi>'.is_cat_limit_axioms,
           unfolded the_cat_discrete_components(1)
           ]
       )
 qed
 
 lemma cat_obj_coprod_ex_is_arr_isomorphism:
   assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C I) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
 proof-
   interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism[
           OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms
           ]
       )
 qed
 
 lemma cat_obj_coprod_ex_is_arr_isomorphism':
   assumes "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<pi>' : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> U' : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" 
     and "\<And>j. j \<in>\<^sub>\<circ> I \<Longrightarrow> \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>"
 proof-
   interpret \<pi>: is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_coprod \<alpha> I A \<CC> U' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism'[
           OF \<pi>.is_cat_colimit_axioms \<pi>'.is_cat_colimit_axioms,
           unfolded the_cat_discrete_components(1)
           ]
       )
 qed
 
 
 
 subsection\<open>Finite product and finite coproduct\<close>
 
 locale is_cat_finite_obj_prod = is_cat_obj_prod \<alpha> I A \<CC> P \<pi> 
   for \<alpha> I A \<CC> P \<pi> +
   assumes cat_fin_obj_prod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>" 
 
 syntax "_is_cat_finite_obj_prod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_finite_obj_prod \<alpha> I A \<CC> P \<pi>"
 
 locale is_cat_finite_obj_coprod = is_cat_obj_coprod \<alpha> I A \<CC> U \<pi> 
   for \<alpha> I A \<CC> U \<pi> +
   assumes cat_fin_obj_coprod_index_in_\<omega>: "I \<in>\<^sub>\<circ> \<omega>" 
 
 syntax "_is_cat_finite_obj_coprod" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n _ :/ _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_finite_obj_coprod \<alpha> I A \<CC> U \<pi>"
 
 lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
   using cat_fin_obj_prod_index_in_\<omega> by auto
 
 sublocale is_cat_finite_obj_prod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
   by (intro finite_categoryI')
     (
       auto
         simp: NTDom.HomDom.category_axioms the_cat_discrete_components
         intro!: cat_fin_obj_prod_index_vfinite
     )
 
 lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
   "vfinite I"
   using cat_fin_obj_coprod_index_in_\<omega> by auto
 
 sublocale is_cat_finite_obj_coprod \<subseteq> I: finite_category \<alpha> \<open>:\<^sub>C I\<close>
   by (intro finite_categoryI')
     (
       auto 
         simp: NTDom.HomDom.category_axioms the_cat_discrete_components 
         intro!: cat_fin_obj_coprod_index_vfinite
     )
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_finite_obj_prod) 
   is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "P' = P" and "A' = A" and "I' = I" and "\<CC>' = \<CC>" 
   shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_obj_prod_axioms)
 
 mk_ide rf 
   is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
   |intro is_cat_finite_obj_prodI|
   |dest is_cat_finite_obj_prodD[dest]|
   |elim is_cat_finite_obj_prodE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD
 
 lemma (in is_cat_finite_obj_coprod) 
   is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "U' = U" and "A' = A" and "I' = I" and "\<CC>' = \<CC>" 
   shows "\<pi> : A' >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n U' : I' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_obj_coprod_axioms)
 
 mk_ide rf 
   is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
   |intro is_cat_finite_obj_coprodI|
   |dest is_cat_finite_obj_coprodD[dest]|
   |elim is_cat_finite_obj_coprodE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
   "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_finite_obj_coprodI)
     (
       cs_concl 
         cs_simp: cat_op_simps 
         cs_intro: cat_fin_obj_prod_index_in_\<omega> cat_cs_intros cat_op_intros
     )
 
 lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n P : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_obj_coprod_op)
 
 lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'
 
 lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
   "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_finite_obj_prodI)
     (
       cs_concl 
         cs_simp: cat_op_simps 
         cs_intro: cat_fin_obj_coprod_index_in_\<omega> cat_cs_intros cat_op_intros
     )
 
 lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : U <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod>\<^sub>.\<^sub>f\<^sub>i\<^sub>n A : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_finite_obj_prod_op)
 
 lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'
 
 
 
 subsection\<open>Product and coproduct of two objects\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 locale is_cat_obj_prod_2 = is_cat_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
   for \<alpha> a b \<CC> P \<pi>
 
 syntax "_is_cat_obj_prod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {_,_} :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi>"
 
 locale is_cat_obj_coprod_2 = is_cat_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
   for \<alpha> a b \<CC> P \<pi>
 
 syntax "_is_cat_obj_coprod_2" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ {_,_} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> _ :/ 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51] 51)
 translations "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi>"
 
 abbreviation proj_fst where "proj_fst \<pi> \<equiv> vpfst (\<pi>\<lparr>NTMap\<rparr>)"
 abbreviation proj_snd where "proj_snd \<pi> \<equiv> vpsnd (\<pi>\<lparr>NTMap\<rparr>)"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>" 
   shows "\<pi> : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a',b'} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_prod_2_axioms)
 
 mk_ide rf is_cat_obj_prod_2_def
   |intro is_cat_obj_prod_2I|
   |dest is_cat_obj_prod_2D[dest]|
   |elim is_cat_obj_prod_2E[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D
 
 lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>" and "P' = P" and "a' = a" and "b' = b" and "\<CC>' = \<CC>" 
   shows "\<pi> : {a',b'} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_coprod_2_axioms)
 
 mk_ide rf is_cat_obj_coprod_2_def
   |intro is_cat_obj_coprod_2I|
   |dest is_cat_obj_coprod_2D[dest]|
   |elim is_cat_obj_coprod_2E[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
   "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])
 
 lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_coprod_2_op)
 
 lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'
 
 lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
   "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])
 
 lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_obj_prod_2_op)
 
 lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'
 
 
 text\<open>Product/coproduct of two objects is a finite product/coproduct.\<close>
 
 sublocale is_cat_obj_prod_2 \<subseteq> is_cat_finite_obj_prod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
 proof(intro is_cat_finite_obj_prodI)
   show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
 qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
 
 sublocale is_cat_obj_coprod_2 \<subseteq> is_cat_finite_obj_coprod \<alpha> \<open>2\<^sub>\<nat>\<close> \<open>if2 a b\<close> \<CC> P \<pi>
 proof(intro is_cat_finite_obj_coprodI)
   show "2\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
 qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
 
 
 text\<open>Elementary properties.\<close>
 
 lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
   shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
 proof-
   have 0: "0 \<in>\<^sub>\<circ> 2\<^sub>\<nat>" and 1: "1\<^sub>\<nat> \<in>\<^sub>\<circ> 2\<^sub>\<nat>" by simp_all
   show "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     by 
       (
         intro 
           cf_discrete_selector_vrange[OF 0, simplified]
           cf_discrete_selector_vrange[OF 1, simplified]
       )+
 qed
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj
 
 lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
   shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   by 
     (
       intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
         OF is_cat_obj_prod_2_op, unfolded cat_op_simps
         ]
     )+
 
 lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj
 
 
 text\<open>Utilities/help lemmas.\<close>
 
 lemma helper_I2_proj_fst_proj_snd_iff: 
   "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<longleftrightarrow>
     (proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and> proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f')" 
   unfolding two by auto
 
 lemma helper_I2_proj_fst_proj_snd_iff': 
   "(\<forall>j\<in>\<^sub>\<circ>2\<^sub>\<nat>. \<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>) \<longleftrightarrow>
     (proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and> proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>)" 
   unfolding two by auto
 
 
 subsubsection\<open>Universal property\<close>
 
 lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows
     "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
       proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
       proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
   by 
     (
       rule cat_obj_prod_unique_cone'[
         OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
         ]
     )
 
 lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and> \<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f'"
   by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])
 
 lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
   assumes "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows
     "\<exists>!f'. f' : P' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
       proj_fst \<pi>' = proj_fst \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
       proj_snd \<pi>' = proj_snd \<pi> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
   by 
     (
       rule cat_obj_prod_unique'[
         OF is_cat_obj_prod_2D[OF assms], 
         unfolded helper_I2_proj_fst_proj_snd_iff
         ]
     )
 
 lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
   assumes "\<pi>' : :\<rightarrow>: (2\<^sub>\<nat>) (if2 a b) \<CC> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e P' : :\<^sub>C (2\<^sub>\<nat>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows
     "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
       proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
       proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
   by 
     (
       rule cat_obj_coprod_unique_cocone'[
         OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
         ]
     )
 
 lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
   assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and> \<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
   by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])
 
 lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
   assumes "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> P' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows
     "\<exists>!f'. f' : P \<mapsto>\<^bsub>\<CC>\<^esub> P' \<and>
       proj_fst \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_fst \<pi> \<and>
       proj_snd \<pi>' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> proj_snd \<pi>"
   by 
     (
       rule cat_obj_coprod_unique'[
         OF is_cat_obj_coprod_2D[OF assms], 
         unfolded helper_I2_proj_fst_proj_snd_iff'
         ]
     )
 
 lemma cat_obj_prod_2_ex_is_arr_isomorphism:
   assumes "\<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<pi>' : P' <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<times> {a,b} : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : P' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> P" and "\<pi>' = \<pi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f"
 proof-
   interpret \<pi>: is_cat_obj_prod_2 \<alpha> a b \<CC> P \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_prod_2 \<alpha> a b \<CC> P' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_obj_prod_ex_is_arr_isomorphism[
           OF \<pi>.is_cat_obj_prod_axioms \<pi>'.is_cat_obj_prod_axioms
           ]
       )
 qed
 
 lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
   assumes "\<pi> : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<pi>' : {a,b} >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<uplus> U' : 2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : U \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> U'" and "\<pi>' = ntcf_const (:\<^sub>C (2\<^sub>\<nat>)) \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<pi>"
 proof-
   interpret \<pi>: is_cat_obj_coprod_2 \<alpha> a b \<CC> U \<pi> by (rule assms(1))
   interpret \<pi>': is_cat_obj_coprod_2 \<alpha> a b \<CC> U' \<pi>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_obj_coprod_ex_is_arr_isomorphism[
           OF \<pi>.is_cat_obj_coprod_axioms \<pi>'.is_cat_obj_coprod_axioms
           ]
       )
 qed
 
 
 
 subsection\<open>Pullbacks and pushouts\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 The definitions and the elementary properties of the pullbacks and the 
 pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in 
 \cite{mac_lane_categories_2010}. 
 \<close>
 
 locale is_cat_pullback =
   is_cat_limit \<alpha> \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x + 
   cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
   for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x 
 
 syntax "_is_cat_pullback" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b _\<rightarrow>_\<rightarrow>_\<leftarrow>_\<leftarrow>_ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
 translations "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
                         
 locale is_cat_pushout =
   is_cat_colimit \<alpha> \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> X x +
   cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>
   for \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x
 
 syntax "_is_cat_pushout" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _\<leftarrow>_\<leftarrow>_\<rightarrow>_\<rightarrow>_ >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o _ \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51, 51, 51] 51)
 translations "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<aa>' = \<aa>"
     and "\<gg>' = \<gg>"
     and "\<oo>' = \<oo>"
     and "\<ff>' = \<ff>"
     and "\<bb>' = \<bb>"
     and "\<CC>' = \<CC>"
     and "X' = X"
   shows "x : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>'\<rightarrow>\<gg>'\<rightarrow>\<oo>'\<leftarrow>\<ff>'\<leftarrow>\<bb>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_pullback_axioms)
 
 mk_ide rf is_cat_pullback_def
   |intro is_cat_pullbackI|
   |dest is_cat_pullbackD[dest]|
   |elim is_cat_pullbackE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_pullbackD
 
 lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<aa>' = \<aa>"
     and "\<gg>' = \<gg>"
     and "\<oo>' = \<oo>"
     and "\<ff>' = \<ff>"
     and "\<bb>' = \<bb>"
     and "\<CC>' = \<CC>"
     and "X' = X"
   shows "x : \<aa>'\<leftarrow>\<gg>'\<leftarrow>\<oo>'\<rightarrow>\<ff>'\<rightarrow>\<bb>' >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_pushout_axioms)
 
 mk_ide rf is_cat_pushout_def
   |intro is_cat_pushoutI|
   |dest is_cat_pushoutD[dest]|
   |elim is_cat_pushoutE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_pushoutD
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_pullback) is_cat_pushout_op:
   "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_pushoutI) 
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_pushout_op)
 
 lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'
 
 lemma (in is_cat_pushout) is_cat_pullback_op:
   "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_pullbackI) 
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
 
 lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_pullback_op)
 
 lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma cat_cone_cospan:
   assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
   shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
     and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
 proof-
   interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x 
     by (rule assms(1))
   interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
   have \<gg>\<^sub>S\<^sub>S: "\<gg>\<^sub>S\<^sub>S : \<aa>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S" and \<ff>\<^sub>S\<^sub>S: "\<ff>\<^sub>S\<^sub>S : \<bb>\<^sub>S\<^sub>S \<mapsto>\<^bsub>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<^esub> \<oo>\<^sub>S\<^sub>S" 
     by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
   from x.ntcf_Comp_commute[OF \<gg>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show
     "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
     by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
   moreover from x.ntcf_Comp_commute[OF \<ff>\<^sub>S\<^sub>S] \<gg>\<^sub>S\<^sub>S \<ff>\<^sub>S\<^sub>S show 
     "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
     by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
   ultimately show "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>" by simp
 qed
 
 lemma (in is_cat_pullback) cat_pb_cone_cospan:
   shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
     and "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
   by (all\<open>rule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]\<close>)
 
 lemma cat_cocone_span:
   assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
   shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
 proof-
   interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x
     by (rule assms(1))
   interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
   note op = 
     cat_cone_cospan
       [
         OF 
           x.is_cat_cone_op[unfolded cat_op_simps] 
           span.cf_scospan_op, 
           unfolded cat_op_simps
       ]
   from op(1) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
     by 
       (
         cs_prems 
           cs_simp: cat_ss_cs_simps cat_op_simps 
           cs_intro: cat_cs_intros cat_ss_cs_intros
       )
   moreover from op(2) show "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
     by 
       (
         cs_prems 
           cs_simp: cat_ss_cs_simps cat_op_simps 
           cs_intro: cat_cs_intros cat_ss_cs_intros
       )
   ultimately show "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>" by auto
 qed
 
 lemma (in is_cat_pushout) cat_po_cocone_span:
   shows "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<oo>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
     and "x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
   by (all\<open>rule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]\<close>)
 
 
 subsubsection\<open>Universal property\<close>
 
 lemma is_cat_pullbackI':
   assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
     and "\<And>x' X'.
       x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
         \<exists>!f'.
           f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
           x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
           x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
   shows "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_cat_pullbackI is_cat_limitI)
 
   show "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     by (rule assms(1))
   interpret x: is_cat_cone \<alpha> X \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x 
     by (rule assms(1))
   show "cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>" by (rule assms(2))
   interpret cospan: cf_scospan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
 
   fix u' r' assume prems:
     "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 
   interpret u': is_cat_cone \<alpha> r' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> u' 
     by (rule prems)
 
   from assms(3)[OF prems] obtain f' 
     where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X"
       and u'_\<aa>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       and u'_\<bb>\<^sub>S\<^sub>S: "u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       and unique_f': "\<And>f''.
         \<lbrakk>
           f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X;
           u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'';
           u'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
         \<rbrakk> \<Longrightarrow> f'' = f'"
     by metis
 
   show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
   proof(intro ex1I conjI; (elim conjE)?)
 
     show "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
     proof(rule ntcf_eqI)
       show "u' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (rule u'.is_ntcf_axioms)
       from f' show 
         "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f' :
           cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
           \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       from f' have dom_rhs: 
         "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       show "u'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>"
       proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
         fix a assume prems': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
         from this f' x.is_ntcf_axioms show
           "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by (elim the_cat_scospan_ObjE; simp only:)
             (
               cs_concl
                 cs_simp:
                   cat_cs_simps cat_ss_cs_simps 
                   u'_\<bb>\<^sub>S\<^sub>S u'_\<aa>\<^sub>S\<^sub>S 
                   cat_cone_cospan(1)[OF assms(1,2)] 
                   cat_cone_cospan(1)[OF prems assms(2)] 
                 cs_intro: cat_cs_intros cat_ss_cs_intros
             )+
       qed (cs_concl cs_intro: cat_cs_intros | auto)+
     qed simp_all
 
     fix f'' assume prems: 
       "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> X" "u' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
     have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" 
       by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
     have "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
     proof-
       from prems(2) have 
         "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by simp
       from this that prems(1) show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed
     from unique_f'[OF prems(1) this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S]] show "f'' = f'".
 
   qed (intro f')
 
 qed
 
 lemma is_cat_pushoutI':
   assumes "x : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC>"
     and "\<And>x' X'. x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
       \<exists>!f'.
         f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
         x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
         x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
   shows "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret x: is_cat_cocone \<alpha> X \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x 
     by (rule assms(1))
   interpret span: cf_sspan \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> by (rule assms(2))
   have assms_3': 
     "\<exists>!f'.
       f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
       x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
       x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
     if "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     for x' X'
   proof-
     from that(1) have [cat_op_simps]:
       "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and> 
       x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
       x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
         f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
         x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
         x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>" 
       for f'
       by (intro iffI conjI; (elim conjE)?)
         (
           cs_concl 
             cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
             cs_intro: cat_cs_intros cat_ss_cs_intros
         )+
     interpret x': 
       is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<open>op_cat \<CC>\<close> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>op_cat \<CC>\<^esub>\<close> x'
       by (rule that)
     show ?thesis
       unfolding cat_op_simps
       by 
         (
           rule assms(3)[
             OF x'.is_cat_cocone_op[unfolded cat_op_simps], 
             unfolded cat_op_simps
             ]
         )
   qed
   interpret op_x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<open>op_cat \<CC>\<close> X \<open>op_ntcf x\<close> 
     using 
       is_cat_pullbackI'
         [
           OF x.is_cat_cone_op[unfolded cat_op_simps] 
           span.cf_scospan_op, 
           unfolded cat_op_simps, 
           OF assms_3'
         ]
     by simp
   show "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
 qed
                    
 lemma (in is_cat_pullback) cat_pb_unique_cone:
   assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'.
     f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
 proof-
   interpret x': is_cat_cone \<alpha> X' \<open>\<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x' 
     by (rule assms)
   from cat_lim_ua_fo[OF assms] obtain f'
     where f': "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X" 
       and x'_def: "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
       and unique_f': "\<And>f''.
         \<lbrakk> f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X; x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' \<rbrakk> \<Longrightarrow>
         f'' = f'"
     by auto
   have \<aa>\<^sub>S\<^sub>S: "\<aa>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" and \<bb>\<^sub>S\<^sub>S: "\<bb>\<^sub>S\<^sub>S \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
     by (cs_concl cs_intro: cat_ss_cs_intros)+
   show ?thesis
   proof(intro ex1I conjI; (elim conjE)?)
     show "f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X" by (rule f')
     have "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" for a
     proof-
       from x'_def have 
         "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         by simp
       from this that f' show "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
         by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed
     from this[OF \<aa>\<^sub>S\<^sub>S] this[OF \<bb>\<^sub>S\<^sub>S] show 
       "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       by auto
     fix f'' assume prems': 
       "f'' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X"
       "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
       "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
     have "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f''"
     proof(rule ntcf_eqI)
       show "x' : cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> : \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (rule x'.is_ntcf_axioms)
       from prems'(1) show
         "x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'' :
           cf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> X' \<mapsto>\<^sub>C\<^sub>F \<langle>\<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> :
           \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       have dom_lhs: "\<D>\<^sub>\<circ> (x'\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>" 
         by (cs_concl cs_simp: cat_cs_simps)
       from prems'(1) have dom_rhs:
         "\<D>\<^sub>\<circ> ((x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>) = \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       show "x'\<lparr>NTMap\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>"
       proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
         fix a assume prems'': "a \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr>"
         from this prems'(1) show 
           "x'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by (elim the_cat_scospan_ObjE; simp only:)
             (
               cs_concl 
                 cs_simp: 
                   prems'(2,3)
                   cat_cone_cospan(1,2)[OF assms cf_scospan_axioms] 
                   cat_pb_cone_cospan 
                   cat_ss_cs_simps cat_cs_simps 
                 cs_intro: cat_ss_cs_intros cat_cs_intros
             )+
       qed (auto simp: cat_cs_intros)
     qed simp_all
     from unique_f'[OF prems'(1) this] show "f'' = f'".
   qed
 qed
 
 lemma (in is_cat_pullback) cat_pb_unique:
   assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and> x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C \<CC> f'"
   by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])
 
 lemma (in is_cat_pullback) cat_pb_unique':
   assumes "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'.
     f' : X' \<mapsto>\<^bsub>\<CC>\<^esub> X \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
 proof-
   interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
   show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
 qed
 
 lemma (in is_cat_pushout) cat_po_unique_cocone:
   assumes "x' : \<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e X' : \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'.
     f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
 proof-
   interpret x': is_cat_cocone \<alpha> X' \<open>\<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<close> \<CC> \<open>\<langle>\<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb>\<rangle>\<^sub>C\<^sub>F\<^bsub>\<CC>\<^esub>\<close> x'
     by (rule assms(1))
   have [cat_op_simps]:
     "f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
       f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
       x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
       x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>" 
     for f'
     by (intro iffI conjI; (elim conjE)?)
       (
         cs_concl 
           cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps  
           cs_intro: cat_cs_intros cat_ss_cs_intros
       )+
   show ?thesis
     by 
       (
         rule is_cat_pullback.cat_pb_unique_cone[
           OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps], 
           unfolded cat_op_simps
           ]
      )
 qed
 
 lemma (in is_cat_pushout) cat_po_unique:
   assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and> x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
   by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])
 
 lemma (in is_cat_pushout) cat_po_unique':
   assumes "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'.
     f' : X \<mapsto>\<^bsub>\<CC>\<^esub> X' \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<and>
     x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
 proof-
   interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(1))
   show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
 qed
 
 lemma cat_pullback_ex_is_arr_isomorphism:
   assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X" 
     and "x' = x \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<rightarrow>\<bullet>\<leftarrow>\<^sub>C  \<CC> f"
 proof-
   interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
   interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism[
           OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
           ]
       )
 qed
 
 lemma cat_pullback_ex_is_arr_isomorphism':
   assumes "x : X <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "x' : X' <\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>b \<aa>\<rightarrow>\<gg>\<rightarrow>\<oo>\<leftarrow>\<ff>\<leftarrow>\<bb> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X" 
     and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   interpret x: is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
   interpret x': is_cat_pullback \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
   obtain f where f: "f : X' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X"
     and "j \<in>\<^sub>\<circ> \<rightarrow>\<bullet>\<leftarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism'[
           OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
           ]
       )
   then have 
     "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" 
     "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     by (auto simp: cat_ss_cs_intros)
   with f show ?thesis using that by simp
 qed
 
 lemma cat_pushout_ex_is_arr_isomorphism:
   assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'" 
     and "x' = ntcf_const \<leftarrow>\<bullet>\<rightarrow>\<^sub>C \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F x"
 proof-
   interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
   interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism[
           OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
           ]
       )
 qed
 
 lemma cat_pushout_ex_is_arr_isomorphism':
   assumes "x : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "x' : \<aa>\<leftarrow>\<gg>\<leftarrow>\<oo>\<rightarrow>\<ff>\<rightarrow>\<bb> >\<^sub>C\<^sub>F\<^sub>.\<^sub>p\<^sub>o X' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'" 
     and "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
     and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
 proof-
   interpret x: is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X x by (rule assms(1))
   interpret x': is_cat_pushout \<alpha> \<aa> \<gg> \<oo> \<ff> \<bb> \<CC> X' x' by (rule assms(2))
   obtain f where f: "f : X \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> X'"
     and "j \<in>\<^sub>\<circ> \<leftarrow>\<bullet>\<rightarrow>\<^sub>C\<lparr>Obj\<rparr> \<Longrightarrow> x'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism'[
           OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
           unfolded the_cat_parallel_components(1)
           ]
       )
   then have "x'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>S\<^sub>S\<rparr>"
     and "x'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> x\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>S\<^sub>S\<rparr>"
     by (auto simp: cat_ss_cs_intros)
   with f show ?thesis using that by simp
 qed
 
 
 
 subsection\<open>Equalizers and coequalizers\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>
 See \cite{noauthor_wikipedia_2001}\footnote{
 \url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
 }.
 \<close>
 
 locale is_cat_equalizer =
   is_cat_limit \<alpha> \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close> E \<epsilon> 
   for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
   assumes cat_eq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and cat_eq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
 
 syntax "_is_cat_equalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ _ <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q '(_,_,_,_') :/ \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
 translations "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
 
 locale is_cat_coequalizer =
   is_cat_colimit \<alpha> \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> \<CC> \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close> E \<epsilon> 
   for \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> +
   assumes cat_coeq_\<gg>[cat_lim_cs_intros]: "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
     and cat_coeq_\<ff>[cat_lim_cs_intros]: "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
 
 syntax "_is_cat_coequalizer" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (\<open>(_ :/ '(_,_,_,_') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q _ :/ \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<index> _)\<close> [51, 51, 51, 51, 51, 51] 51)
 translations "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" \<rightleftharpoons> 
   "CONST is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon>"
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "E' = E"
     and "\<aa>' = \<aa>"
     and "\<bb>' = \<bb>"
     and "\<gg>' = \<gg>"
     and "\<ff>' = \<ff>"
     and "\<CC>' = \<CC>"
   shows "\<epsilon> : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>',\<bb>',\<gg>',\<ff>') : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_equalizer_axioms)
 
 mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
   |intro is_cat_equalizerI|
   |dest is_cat_equalizerD[dest]|
   |elim is_cat_equalizerE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)
 
 lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "E' = E"
     and "\<aa>' = \<aa>"
     and "\<bb>' = \<bb>"
     and "\<gg>' = \<gg>"
     and "\<ff>' = \<ff>"
     and "\<CC>' = \<CC>"
   shows "\<epsilon> : (\<aa>',\<bb>',\<gg>',\<ff>') >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_coequalizer_axioms)
 
 mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
   |intro is_cat_coequalizerI|
   |dest is_cat_coequalizerD[dest]|
   |elim is_cat_coequalizerE[elim]|
 
 lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)
 
 
 text\<open>Elementary properties.\<close>
 
 sublocale is_cat_equalizer \<subseteq> cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC> 
   by (intro cf_parallelI cat_parallelI)
     (simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)
 
 sublocale is_cat_coequalizer \<subseteq> cf_parallel \<alpha> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>
   by (intro cf_parallelI cat_parallelI)
     (
       simp_all add: 
         cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros 
         cat_PL_ineq[symmetric]
     )
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_equalizer) is_cat_coequalizer_op:
   "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_coequalizerI)
     (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros cat_lim_cs_intros)+
 
 lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_coequalizer_op)
 
 lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'
 
 lemma (in is_cat_coequalizer) is_cat_equalizer_op:
   "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
   by (intro is_cat_equalizerI)
     (
       cs_concl
         cs_simp: cat_op_simps
         cs_intro: cat_cs_intros cat_op_intros cat_lim_cs_intros
     )+
 
 lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
   assumes "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>'"
   unfolding assms by (rule is_cat_equalizer_op)
 
 lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'
 
 
 text\<open>Elementary properties.\<close>
 
 lemma cf_parallel_if_is_cat_cone:
   assumes "\<epsilon> :
     E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
   shows "cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>"
 proof-
   let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
   interpret is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
   show ?thesis
     by (intro cf_parallelI cat_parallelI)
       (
         simp_all add: 
           assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
       )
 qed
 
 lemma cf_parallel_if_is_cat_cocone:
   assumes "\<epsilon>' :
     \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
     and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
   shows "cf_parallel \<alpha> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>"
 proof-
   let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
   interpret is_cat_cocone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
   show ?thesis
     by (intro cf_parallelI cat_parallelI)
       (
         simp_all add: 
           assms 
           cat_parallel_cs_intros 
           cat_lim_cs_intros 
           cat_cs_intros
           cat_PL_ineq[symmetric]
       )
 qed
 
 lemma (in category) cat_cf_parallel_cat_equalizer: 
   assumes "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
   shows "cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>"
   using assms 
   by (intro cf_parallelI cat_parallelI)
     (auto simp: cat_parallel_cs_intros cat_cs_intros)
 
 lemma (in category) cat_cf_parallel_cat_coequalizer: 
   assumes "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
   shows "cf_parallel \<alpha> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>"
   using assms 
   by (intro cf_parallelI cat_parallelI)
     (simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL_ineq[symmetric])
 
 lemma cat_cone_cf_par_eps_NTMap_app:
   assumes "\<epsilon> :
     E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>" 
     and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
   shows 
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>" 
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
 proof-
   let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
   interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
   from assms(2,3) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   interpret par: cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC> 
     by (intro cf_parallel_if_is_cat_cone, rule assms) (auto intro: assms \<aa> \<bb>)
   have \<gg>\<^sub>P\<^sub>L: "\<gg>\<^sub>P\<^sub>L : \<aa>\<^sub>P\<^sub>L \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<^esub> \<bb>\<^sub>P\<^sub>L" 
     and \<ff>\<^sub>P\<^sub>L: "\<ff>\<^sub>P\<^sub>L : \<aa>\<^sub>P\<^sub>L \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<^esub> \<bb>\<^sub>P\<^sub>L"
     by 
       (
         simp_all add: 
           par.the_cat_parallel_is_arr_\<aa>\<bb>\<gg> par.the_cat_parallel_is_arr_\<aa>\<bb>\<ff>
       )
   from \<epsilon>.ntcf_Comp_commute[OF \<gg>\<^sub>P\<^sub>L] show "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
     by (*slow*)
       (
         cs_prems 
           cs_simp: cat_parallel_cs_simps cat_cs_simps 
           cs_intro: cat_cs_intros cat_parallel_cs_intros 
       )
   from \<epsilon>.ntcf_Comp_commute[OF \<ff>\<^sub>P\<^sub>L] show "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
     by (*slow*)
       (
         cs_prems 
           cs_simp: cat_parallel_cs_simps cat_cs_simps 
           cs_intro: cat_cs_intros cat_parallel_cs_intros 
       )
 qed
 
 lemma cat_cocone_cf_par_eps_NTMap_app:
   assumes "\<epsilon> :
     \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E : \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" 
     and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
   shows 
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>" 
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"    
 proof-
   let ?II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
   interpret \<epsilon>: is_cat_cocone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
   from assms(2,3) have \<aa>: "\<aa> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and \<bb>: "\<bb> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   interpret par: cf_parallel \<alpha> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC> 
     by (intro cf_parallel_if_is_cat_cocone, rule assms) (auto intro: assms \<aa> \<bb>)
   note \<epsilon>_NTMap_app = 
     cat_cone_cf_par_eps_NTMap_app[
       OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps],
       unfolded cat_op_simps,  
       OF assms(2,3)
       ]
   from \<epsilon>_NTMap_app show \<epsilon>_NTMap_app:
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
     "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
     by 
       (
         cs_concl
           cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric] 
           cs_intro: cat_cs_intros cat_parallel_cs_intros
       )+
 qed
 
 lemma (in is_cat_equalizer) cat_eq_2_eps_NTMap_app:
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>" 
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
   by 
     (
       intro cat_cone_cf_par_eps_NTMap_app[
         OF is_cat_cone_axioms cat_eq_\<gg> cat_eq_\<ff>
         ]
     )+
 
 lemma (in is_cat_coequalizer) cat_coeq_2_eps_NTMap_app:
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>" 
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
   by 
     (
       intro cat_cocone_cf_par_eps_NTMap_app[
         OF is_cat_cocone_axioms cat_coeq_\<gg> cat_coeq_\<ff>
         ]
     )+
 
 lemma (in is_cat_equalizer) cat_eq_Comp_eq: 
   "\<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
   "\<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
   unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all
 
 lemma (in is_cat_coequalizer) cat_coeq_Comp_eq: 
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff>"
   "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<ff> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<gg>"
   unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all
 
 
 subsubsection\<open>Universal property\<close>
 
 lemma is_cat_equalizerI':
   assumes "\<epsilon> :
     E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and "\<And>\<epsilon>' E'. \<epsilon>' :
       E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : 
       \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
       \<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
   shows "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
   interpret \<epsilon>: is_cat_cone \<alpha> E ?II \<CC> ?II_II \<epsilon> by (rule assms(1))
   interpret \<CC>: cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC>
     by (rule \<epsilon>.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms(2,3)])
   show ?thesis
   proof(intro is_cat_equalizerI is_cat_limitI assms(1-3))
     fix u' r' assume prems: "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     interpret u': is_cat_cone \<alpha> r' ?II \<CC> ?II_II u' by (rule prems)
     from assms(4)[OF prems] obtain f'
       where f': "f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
         and u'_NTMap_app_\<aa>: "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
         and unique_f': 
           "\<And>f''.
             \<lbrakk>
               f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E; 
               u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
             \<rbrakk> \<Longrightarrow> f'' = f'"
       by metis
     show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
     proof(intro ex1I conjI; (elim conjE)?)
       show "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
       proof(rule ntcf_eqI)
         show "u' : cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
           by (rule u'.is_ntcf_axioms)
         from f' show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f' :
           cf_const ?II \<CC> r' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
           by 
             (
               cs_concl 
                 cs_simp: cat_cs_simps cat_ss_cs_simps 
                 cs_intro: cat_cs_intros cat_ss_cs_intros
             )
         have dom_lhs: "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
           unfolding cat_cs_simps by simp
         from f' have dom_rhs:
           "\<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>) = ?II\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         show "u'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
           fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
           note [cat_parallel_cs_simps] = 
             cat_cone_cf_par_eps_NTMap_app[OF u'.is_cat_cone_axioms assms(2-3)]
             cat_cone_cf_par_eps_NTMap_app[OF assms(1-3)]
             u'_NTMap_app_\<aa>
           from prems' f' assms(2,3) show 
             "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
             by (elim the_cat_parallel_ObjE; simp only:)
               (
                 cs_concl 
                   cs_simp: cat_parallel_cs_simps cat_cs_simps
                   cs_intro: cat_cs_intros cat_parallel_cs_intros
               )
         qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
       qed simp_all
       fix f'' assume prems'': 
         "f'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
       from prems''(2) have u'_NTMap_a:
         "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         for a 
         by simp
       have "u'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"  
         using u'_NTMap_a[of \<aa>\<^sub>P\<^sub>L] prems''(1) 
         by 
           (
             cs_prems 
               cs_simp: cat_parallel_cs_simps cat_cs_simps 
               cs_intro: cat_parallel_cs_intros cat_cs_intros
           )
       from unique_f'[OF prems''(1) this] show "f'' = f'".
     qed (rule f')
   qed
 qed
 
 lemma is_cat_coequalizerI':
   assumes "\<epsilon> :
     \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E : 
     \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
     and "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
     and "\<And>\<epsilon>' E'. \<epsilon>' :
       \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : 
       \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<Longrightarrow>
       \<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
   shows "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   let ?op_II = \<open>\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<close> 
     and ?op_II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg>\<close>
     and ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close>
     and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> (op_cat \<CC>) \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<close>
   interpret \<epsilon>: is_cat_cocone \<alpha> E ?op_II \<CC> ?op_II_II \<epsilon> by (rule assms(1))
   interpret par: cf_parallel \<alpha> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L  \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> \<CC>
     by (rule \<epsilon>.NTDom.HomCod.cat_cf_parallel_cat_coequalizer[OF assms(2,3)])
   interpret op_par: cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<open>op_cat \<CC>\<close>
     by (rule par.cf_parallel_op)
   have assms_4': 
     "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f'"
     if "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>" for \<epsilon>' E'
   proof-
     have [cat_op_simps]:
       "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
         f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
       for f'
       by (intro iffI conjI; (elim conjE)?)
         (
           cs_concl 
             cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
             cs_intro: cat_cs_intros cat_parallel_cs_intros
         )+
     interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<open>op_cat \<CC>\<close> ?II_II \<epsilon>' by (rule that)
     show ?thesis
       unfolding cat_op_simps
       by 
         (
           rule assms(4)[
             OF \<epsilon>'.is_cat_cocone_op[unfolded cat_op_simps], 
             unfolded cat_op_simps
             ]
         )
   qed
   interpret op_\<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<open>op_cat \<CC>\<close> E \<open>op_ntcf \<epsilon>\<close> 
     by 
       (
         rule 
           is_cat_equalizerI'
             [
               OF \<epsilon>.is_cat_cone_op[unfolded cat_op_simps], 
               unfolded cat_op_simps, 
               OF assms(2,3) assms_4'
             ]
       )
   show ?thesis by (rule op_\<epsilon>.is_cat_coequalizer_op[unfolded cat_op_simps])
 qed
 
 lemma (in is_cat_equalizer) cat_eq_unique_cone:
   assumes "\<epsilon>' :
     E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     (is \<open>\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
   shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
 proof-
   interpret \<epsilon>': is_cat_cone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
   from cat_lim_ua_fo[OF assms(1)] obtain f' where f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E"
     and \<epsilon>'_def: "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'"
     and unique: 
       "\<lbrakk> f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' \<rbrakk> \<Longrightarrow> f'' = f'" 
     for f''
     by auto
   show ?thesis
   proof(intro ex1I conjI; (elim conjE)?)
     show f': "f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" by (rule f')
     from \<epsilon>'_def have "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f')\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
       by simp
     from this f' show \<epsilon>'_NTMap_app_I: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       by 
         (
           cs_prems 
             cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
         )
     fix f'' assume prems: 
       "f'' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E" "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
     have "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f''"
     proof(rule ntcf_eqI[OF ])
       show "\<epsilon>' : cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (rule \<epsilon>'.is_ntcf_axioms)
       from f' prems(1) show "\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'' :
         cf_const ?II \<CC> E' \<mapsto>\<^sub>C\<^sub>F ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       show "\<epsilon>'\<lparr>NTMap\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>"
       proof(rule vsv_eqI, unfold cat_cs_simps)
         show "vsv ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
           by (cs_concl cs_intro: cat_cs_intros)
         from prems(1) show 
           "?II\<lparr>Obj\<rparr> = \<D>\<^sub>\<circ> ((\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>)"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         fix a assume prems': "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
         note [cat_cs_simps] = 
           cat_eq_2_eps_NTMap_app
           cat_cone_cf_par_eps_NTMap_app[
             OF \<epsilon>'.is_cat_cone_axioms cf_parallel_\<gg>' cf_parallel_\<ff>'
             ]
         from prems' prems(1) have [cat_cs_simps]: 
           "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''"
           by (elim the_cat_parallel_ObjE; simp only:)
             (
                 cs_concl 
                   cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
                   cs_intro: cat_cs_intros cat_parallel_cs_intros
             )+
         from prems' prems show 
           "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const ?II \<CC> f'')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       qed auto
     qed simp_all
     from unique[OF prems(1) this] show "f'' = f'" .      
   qed
 qed
 
 lemma (in is_cat_equalizer) cat_eq_unique:
   assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows 
     "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f'"
   by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])
 
 lemma (in is_cat_equalizer) cat_eq_unique':
   assumes "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : E' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
 proof-
   interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(1))
   show ?thesis by (rule cat_eq_unique_cone[OF \<epsilon>'.is_cat_cone_axioms])
 qed
 
 lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
   assumes "\<epsilon>' :
     \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<bb> \<aa> \<ff> \<gg> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     (is \<open>\<epsilon>' : ?II_II >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>c\<^sub>o\<^sub>n\<^sub>e E' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>\<close>)
   shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
 proof-
   interpret \<epsilon>': is_cat_cocone \<alpha> E' ?II \<CC> ?II_II \<epsilon>' by (rule assms(1))
   have [cat_op_simps]:
     "f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>op_cat \<CC>\<^esub> f' \<longleftrightarrow>
       f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>" 
     for f'
     by (intro iffI conjI; (elim conjE)?)
       (
         cs_concl
           cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
           cs_intro: cat_cs_intros cat_parallel_cs_intros
       )+
   show ?thesis
     by 
       (
         rule is_cat_equalizer.cat_eq_unique_cone[
           OF is_cat_equalizer_op \<epsilon>'.is_cat_cone_op[unfolded cat_op_simps],
           unfolded cat_op_simps
           ]
      )
 qed
 
 lemma (in is_cat_coequalizer) cat_coeq_unique:
   assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'.
     f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and>
     \<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L) \<CC> f' \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
   by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])
 
 lemma (in is_cat_coequalizer) cat_coeq_unique':
   assumes "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   shows "\<exists>!f'. f' : E \<mapsto>\<^bsub>\<CC>\<^esub> E' \<and> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
 proof-
   interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(1))
   show ?thesis by (rule cat_coeq_unique_cocone[OF \<epsilon>'.is_cat_cocone_axioms])
 qed
 
 lemma cat_equalizer_2_ex_is_arr_isomorphism:
   assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
     and "\<epsilon>' = \<epsilon> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> f"
 proof-
   interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
   interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism[
           OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
           ]
       )
 qed
 
 lemma cat_equalizer_2_ex_is_arr_isomorphism':
   assumes "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     and "\<epsilon>' : E' <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
     and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
 proof-
   interpret \<epsilon>: is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
   interpret \<epsilon>': is_cat_equalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
   obtain f where f: "f : E' \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E"
     and "j \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f" for j
     by 
       (
         elim cat_lim_ex_is_arr_isomorphism'[
           OF \<epsilon>.is_cat_limit_axioms \<epsilon>'.is_cat_limit_axioms
           ]
       )
   then have 
     "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f"
     unfolding the_cat_parallel_components by auto
   with f show ?thesis using that by simp
 qed
 
 lemma cat_coequalizer_2_ex_is_arr_isomorphism:
   assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'" 
     and "\<epsilon>' = ntcf_const (\<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L)  \<CC> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>"
 proof-
   interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
   interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
   from that show ?thesis
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism[
           OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
           ]
       )
 qed
 
 lemma cat_coequalizer_2_ex_is_arr_isomorphism':
   assumes "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<epsilon>' : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E' : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains f where "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'" 
     and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
     and "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr>"
 proof-
   interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule assms(1))
   interpret \<epsilon>': is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E' \<epsilon>' by (rule assms(2))
   obtain f where f: "f : E \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>\<^esub> E'"
     and "j \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<bb>\<^sub>P\<^sub>L \<aa>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L\<lparr>Obj\<rparr> \<Longrightarrow> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" for j
     by 
       (
         elim cat_colim_ex_is_arr_isomorphism'[
           OF \<epsilon>.is_cat_colimit_axioms \<epsilon>'.is_cat_colimit_axioms
           ]
       )
   then have 
     "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>"
     "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr> = f \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<bb>\<^sub>P\<^sub>L\<rparr>"
     unfolding the_cat_parallel_components by auto
   with f show ?thesis using that by simp
 qed
 
 
 
 subsection\<open>Projection cone\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition ntcf_obj_prod_base :: "V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "ntcf_obj_prod_base \<CC> I F P f =
     [(\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j), cf_const (:\<^sub>C I) \<CC> P, :\<rightarrow>: I F \<CC>, :\<^sub>C I, \<CC>]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_obj_prod_base_components:
   shows "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr> = (\<lambda>j\<in>\<^sub>\<circ>:\<^sub>C I\<lparr>Obj\<rparr>. f j)"
     and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDom\<rparr> = cf_const (:\<^sub>C I) \<CC> P"
     and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTCod\<rparr> = :\<rightarrow>: I F \<CC>"
     and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGDom\<rparr> = :\<^sub>C I"
     and "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTDGCod\<rparr> = \<CC>"
   unfolding ntcf_obj_prod_base_def nt_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda ntcf_obj_prod_base_components(1)
   |vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]|
   |vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]|
   |app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]|
 
 
 subsubsection\<open>Projection natural transformation is a cone\<close>
 
 lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
   assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
   shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
   from assms(2) have [cat_cs_intros]: 
     "\<lbrakk> a \<in>\<^sub>\<circ> I; P' = P; Fa = F a \<rbrakk> \<Longrightarrow> f a : P' \<mapsto>\<^bsub>\<CC>\<^esub> Fa" for a P' Fa 
     by simp
   show "vfsequence (ntcf_obj_prod_base \<CC> I F P f)"
     unfolding ntcf_obj_prod_base_def by auto
   show "vcard (ntcf_obj_prod_base \<CC> I F P f) = 5\<^sub>\<nat>"
     unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
   from assms show "cf_const (:\<^sub>C I) \<CC> P : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by 
       (
         cs_concl
           cs_intro: 
             cf_discrete_vdomain_vsubset_Vset 
             cat_discrete_cs_intros 
             cat_cs_intros
       )
   show ":\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by (cs_concl cs_intro: cat_discrete_cs_intros)
   show "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr> :
     cf_const (:\<^sub>C I) \<CC> P\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> :\<rightarrow>: I F \<CC>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     if "a \<in>\<^sub>\<circ> :\<^sub>C I\<lparr>Obj\<rparr>" for a
   proof-
     from that have "a \<in>\<^sub>\<circ> I" unfolding the_cat_discrete_components by simp
     from that this show ?thesis
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
         )
   qed
   show 
     "ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
       cf_const (:\<^sub>C I) \<CC> P\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> =
       :\<rightarrow>: I F \<CC>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ntcf_obj_prod_base \<CC> I F P f\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
     if "g : a \<mapsto>\<^bsub>:\<^sub>C I\<^esub> b" for a b g
   proof-
     note g = the_cat_discrete_is_arrD[OF that]
     from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
       unfolding g(7-9)
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_discrete_cs_simps 
             cs_intro: 
               cf_discrete_vdomain_vsubset_Vset 
               cat_cs_intros cat_discrete_cs_intros
         )
   qed
 qed 
   (
     auto simp: 
       assms 
       ntcf_obj_prod_base_components 
       tm_cf_discrete_the_cf_discrete_is_tm_functor
   )
 
 lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
   assumes "P \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" 
     and "\<And>a. a \<in>\<^sub>\<circ> I \<Longrightarrow> f a : P \<mapsto>\<^bsub>\<CC>\<^esub> F a"
     and "\<And>u' r'.
       \<lbrakk> u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: I F \<CC> : :\<^sub>C I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC> \<rbrakk> \<Longrightarrow> 
         \<exists>!f'.
           f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P \<and>
           u' = ntcf_obj_prod_base \<CC> I F P f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const (:\<^sub>C I) \<CC> f'"
   shows "ntcf_obj_prod_base \<CC> I F P f : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> F : I \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof
   (
     intro 
       is_cat_obj_prodI 
       is_cat_limitI 
       tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified] 
       assms(1,3)
   )
   show "cf_discrete \<alpha> I F \<CC>"
     by (cs_concl cs_intro: cat_small_discrete_cs_intros)
 qed
 
 
 
 subsection\<open>Equalizer cone\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition ntcf_equalizer_base :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> (V \<Rightarrow> V) \<Rightarrow> V"
   where "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e =
     [
       (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x),
       cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E,
       \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>,
       \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L,
       \<CC>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma ntcf_equalizer_base_components:
   shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr> =
     (\<lambda>x\<in>\<^sub>\<circ>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>. e x)"
     and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDom\<rparr> =
       cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E"
     and [cat_lim_cs_simps]: "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTCod\<rparr> =
       \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>"
     and [cat_lim_cs_simps]: 
       "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGDom\<rparr> = \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L"
     and [cat_lim_cs_simps]: 
       "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTDGCod\<rparr> = \<CC>"
   unfolding ntcf_equalizer_base_def nt_field_simps 
   by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda ntcf_equalizer_base_components(1)
   |vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]|
   |vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]|
   |app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]|
 
 
 subsubsection\<open>Equalizer cone is a cone\<close>
 
 lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
   assumes "e \<aa>\<^sub>P\<^sub>L : E \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>"
     and "e \<bb>\<^sub>P\<^sub>L : E \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and "e \<bb>\<^sub>P\<^sub>L = \<gg> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L"
     and "e \<bb>\<^sub>P\<^sub>L = \<ff> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> e \<aa>\<^sub>P\<^sub>L"
     and "\<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
     and "\<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>"
   shows "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e :
     E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> :
     \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret par: cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> \<CC> 
     by (intro cf_parallelI cat_parallelI assms(5,6))
       (simp_all add: cat_parallel_cs_intros cat_cs_intros)
   show ?thesis
   proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
     show "vfsequence (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e)"
       unfolding ntcf_equalizer_base_def by auto
     show "vcard (ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e) = 5\<^sub>\<nat>"
       unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
     from assms(2) show 
       "cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps 
             cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
         )
     from assms show 
       "\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff> : \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by (cs_concl cs_simp: cs_intro: cat_parallel_cs_intros cat_small_cs_intros)
     show 
       "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>i\<rparr> :
         cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub>
         \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>"
       if "i \<in>\<^sub>\<circ> \<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<lparr>Obj\<rparr>" for i 
     proof-
       from that assms(1,2,5,6) show ?thesis
         by (elim the_cat_parallel_ObjE; simp only:)
           ( 
             cs_concl 
               cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps 
               cs_intro: cat_cs_intros cat_parallel_cs_intros
           )
     qed
     show 
       "ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
         cf_const (\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L) \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> =
           \<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L \<aa> \<bb> \<gg> \<ff>\<lparr>ArrMap\<rparr>\<lparr>f'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub>
           ntcf_equalizer_base \<CC> \<aa> \<bb> \<gg> \<ff> E e\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
       if "f' : a' \<mapsto>\<^bsub>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<^esub> b'" for a' b' f'
       using that assms(1,2,5,6)
       by (elim par.the_cat_parallel_is_arrE; simp only:)
         (
           cs_concl 
             cs_simp: 
               cat_cs_simps 
               cat_lim_cs_simps 
               cat_parallel_cs_simps 
               assms(3,4)[symmetric]
             cs_intro: cat_parallel_cs_intros
         )+
   qed 
     (
       use assms(2) in 
         \<open>
           cs_concl
             cs_intro: cat_lim_cs_intros cat_cs_intros 
             cs_simp: cat_lim_cs_simps
         \<close>
     )+
 qed
 
 
 
 subsection\<open>Limits by products and equalizers\<close>
 
 lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
   \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb>; \<gg> : \<aa> \<mapsto>\<^bsub>\<CC>\<^esub> \<bb> \<rbrakk> \<Longrightarrow>
       \<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
       \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
       \<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains r u where "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
 
   let ?L =\<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?R =\<open>\<lambda>i. \<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<close>
   
   interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
 
   have "?R j \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
     by (cs_concl cs_intro: cat_cs_intros that)
 
   have "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
   proof(intro tm_cf_discreteI)
     show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
       by (cs_concl cs_intro: cat_cs_intros that)
     show "VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule vbrelation.vbrelation_Limit_in_VsetI)
       show "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<in>\<^sub>\<circ> Vset \<alpha>"
       proof-
         have "\<R>\<^sub>\<circ> (VLambda (\<JJ>\<lparr>Obj\<rparr>) ?R) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
           by (auto simp: \<FF>.cf_ObjMap_vdomain)
         moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
           by (force intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
         ultimately show ?thesis by auto
       qed
     qed (auto simp: cat_small_cs_intros)
     show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule vbrelation.vbrelation_Limit_in_VsetI)
       show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
       proof-
         have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
         proof(rule vrange_VLambda_vsubset)
           fix x assume x: "x \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>"
           then have "\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
             by (auto intro: cat_cs_intros simp: cat_cs_simps)
           moreover from x have "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>x\<rparr>\<rparr>"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
             by (simp add: \<FF>.ArrMap.vsv_vimageI2)
         qed
         moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
           by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
         ultimately show ?thesis by auto
       qed
     qed (auto simp: cat_small_cs_intros)
   qed (auto intro: cat_cs_intros)
 
   from assms(3)[where A=\<open>?R\<close>, OF this] obtain P\<^sub>O \<pi>\<^sub>O
     where \<pi>\<^sub>O: "\<pi>\<^sub>O : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?R : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by clarsimp
 
   interpret \<pi>\<^sub>O: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> ?R \<CC> P\<^sub>O \<pi>\<^sub>O by (rule \<pi>\<^sub>O)
 
   have P\<^sub>O: "P\<^sub>O \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by (intro \<pi>\<^sub>O.cat_cone_obj)
 
   have "?L u \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "u \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for u
   proof-
     from that obtain a b where "u : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
     then show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   qed
 
   have tm_cf_discrete: "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>"
   proof(intro tm_cf_discreteI)
     show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
     proof-
       from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
       then show ?thesis 
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     qed
  
     show "(\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule vbrelation.vbrelation_Limit_in_VsetI)
       show "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<in>\<^sub>\<circ> Vset \<alpha>"
       proof-
         have "\<R>\<^sub>\<circ> (\<lambda>u\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. ?L u) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
         proof(rule vrange_VLambda_vsubset)
           fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
           then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
           then show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>)"
             by 
               (
                 cs_concl 
                   cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
               )
         qed
         moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
           by (auto intro: vrange_in_VsetI \<FF>.tm_cf_ObjMap_in_Vset)
         ultimately show ?thesis by auto
       qed
     qed (auto simp: cat_small_cs_intros)
 
     show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
     proof(rule vbrelation.vbrelation_Limit_in_VsetI)
       show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
       proof-
         have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Arr\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>i\<rparr>\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
         proof(rule vrange_VLambda_vsubset)
           fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
           then obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
           then have "\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
             by (auto intro: cat_cs_intros simp: cat_cs_simps)
           moreover from f have 
             "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>b\<rparr>\<rparr>"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           ultimately show "\<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>\<rparr> \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
             by (simp add: \<FF>.ArrMap.vsv_vimageI2)
         qed
         moreover have "\<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
           by (force intro: vrange_in_VsetI \<FF>.tm_cf_ArrMap_in_Vset)
         ultimately show ?thesis by auto
       qed
     qed (auto simp: cat_small_cs_intros)
   qed (auto intro: cat_cs_intros)
 
   from assms(4)[where A=\<open>?L\<close>, OF this, simplified] obtain P\<^sub>A \<pi>\<^sub>A
     where \<pi>\<^sub>A: "\<pi>\<^sub>A : P\<^sub>A <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> ?L : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by auto
 
   interpret \<pi>\<^sub>A: is_cat_obj_prod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> ?L \<CC> P\<^sub>A \<pi>\<^sub>A by (rule \<pi>\<^sub>A)
 
   let ?F = \<open>\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> and ?f = \<open>\<lambda>u. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> 
   let ?\<pi>\<^sub>O' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?f\<close>
 
   have \<pi>\<^sub>O': "?\<pi>\<^sub>O' :
     P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) (\<lambda>u. \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>) \<CC> :
     :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     unfolding the_cat_discrete_components(1)
   proof
     (
       intro 
         tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
         tm_cf_discrete
     )
     fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
     then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
     then show "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
       by 
         (
           cs_concl
             cs_simp:
               the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
             cs_intro: cat_cs_intros
         )
   qed (intro P\<^sub>O)
 
   from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O'] obtain f' 
     where f': "f' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
       and \<pi>\<^sub>O'_NTMap_app: 
         "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'"
       and unique_f':
         "\<lbrakk>
           f'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
           \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f''
          \<rbrakk> \<Longrightarrow> f'' = f'"
       for f''
     by metis
 
   have \<pi>\<^sub>O_NTMap_app_Cod: 
     "\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'" if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b 
   proof-
     from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
     from \<pi>\<^sub>O'_NTMap_app[OF this] that show ?thesis
       by 
         (
           cs_prems 
             cs_simp: cat_cs_simps the_cat_discrete_components(1)
             cs_intro: cat_cs_intros
         )
   qed
 
   from this[symmetric] have \<pi>\<^sub>A_NTMap_Comp_app: 
     "\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q" 
     if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O" for q f a b c 
     using that f'
     by (intro \<FF>.HomCod.cat_assoc_helper)
       (
         cs_concl 
           cs_simp: 
             cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
           cs_intro: cat_cs_intros
       )+
 
   let ?g = \<open>\<lambda>u. \<FF>\<lparr>ArrMap\<rparr>\<lparr>u\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>u\<rparr>\<rparr>\<close> 
   let ?\<pi>\<^sub>O'' = \<open>ntcf_obj_prod_base \<CC> (:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<lparr>Obj\<rparr>) ?F P\<^sub>O ?g\<close>
   
   have \<pi>\<^sub>O'': "?\<pi>\<^sub>O'' : P\<^sub>O <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     unfolding the_cat_discrete_components(1)
   proof
     (
       intro 
         tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone  
         tm_cf_discrete
     )
     show "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Dom\<rparr>\<lparr>f\<rparr>\<rparr> : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
       if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
     proof-
       from that obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b"  by auto
       then show ?thesis
         by  
           (
             cs_concl 
               cs_simp: 
                 cat_cs_simps cat_discrete_cs_simps 
                 the_cat_discrete_components(1) 
               cs_intro: cat_cs_intros
           )
     qed
   qed (intro P\<^sub>O)
 
   from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF \<pi>\<^sub>O''] obtain g' 
     where g': "g' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
       and \<pi>\<^sub>O''_NTMap_app: 
         "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'"
       and unique_g':
         "\<lbrakk>
           g'' : P\<^sub>O \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
           \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>\<^sub>O''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g''
          \<rbrakk> \<Longrightarrow> g'' = g'"
       for g''
     by (metis (lifting))
 
   have "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g'" 
     if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b 
   proof-
     from that have "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" by auto
     from \<pi>\<^sub>O''_NTMap_app[OF this] that show ?thesis
       by 
         (
           cs_prems 
             cs_simp: cat_cs_simps the_cat_discrete_components(1)
             cs_intro: cat_cs_intros
         )
   qed
   then have \<pi>\<^sub>O_NTMap_app_Dom: 
     "\<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>a\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q) =
       (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> q" 
     if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" and "q : c \<mapsto>\<^bsub>\<CC>\<^esub>  P\<^sub>O" for q f a b c 
     using that g' 
     by (intro \<FF>.HomCod.cat_assoc_helper)
       (
         cs_concl 
           cs_simp: 
             cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
           cs_intro: cat_cs_intros
       )
 
   from assms(2)[OF f' g'] obtain E \<epsilon> where \<epsilon>: 
     "\<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (P\<^sub>O,P\<^sub>A,g',f') : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     by clarsimp
 
   interpret \<epsilon>: is_cat_equalizer \<alpha> P\<^sub>O P\<^sub>A g' f' \<CC> E \<epsilon> by (rule \<epsilon>)
 
   define \<mu> where "\<mu> =
     [(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>), cf_const \<JJ> \<CC> E, \<FF>, \<JJ>, \<CC>]\<^sub>\<circ>"
 
   have \<mu>_components:
     "\<mu>\<lparr>NTMap\<rparr> = (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>)"
     "\<mu>\<lparr>NTDom\<rparr> = cf_const \<JJ> \<CC> E"
     "\<mu>\<lparr>NTCod\<rparr> = \<FF>"
     "\<mu>\<lparr>NTDGDom\<rparr> = \<JJ>"
     "\<mu>\<lparr>NTDGCod\<rparr> = \<CC>"
     unfolding \<mu>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
   have [cat_cs_simps]: 
     "\<mu>\<lparr>NTMap\<rparr>\<lparr>i\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>i\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" 
     for i
     using that unfolding \<mu>_components by simp
 
   have "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   proof(intro is_cat_limitI)
 
     show \<mu>: "\<mu> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" 
     proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
       show "vfsequence \<mu>" unfolding \<mu>_def by simp 
       show "vcard \<mu> = 5\<^sub>\<nat>" unfolding \<mu>_def by (simp add: nat_omega_simps)
       show "cf_const \<JJ> \<CC> E : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
       show "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (cs_concl cs_intro: cat_cs_intros)
       show "\<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : cf_const \<JJ> \<CC> E\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         if "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for a
         using that
         by 
           (
             cs_concl 
               cs_simp: 
                 cat_cs_simps 
                 cat_discrete_cs_simps 
                 cat_parallel_cs_simps 
                 the_cat_discrete_components(1) 
               cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
           )
       show 
         "\<mu>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const \<JJ> \<CC> E\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
           \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<mu>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for a b f
         using that \<epsilon> g' f' 
         by 
           (
             cs_concl
               cs_simp:
                 cat_parallel_cs_simps
                 cat_cs_simps 
                 the_cat_discrete_components(1) 
                 \<pi>\<^sub>O_NTMap_app_Cod 
                 \<pi>\<^sub>O_NTMap_app_Dom 
                 \<epsilon>.cat_eq_Comp_eq(1) 
               cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
           )
 
     qed (auto simp: \<mu>_components cat_lim_cs_intros)
 
     interpret \<mu>: is_cat_cone \<alpha> E \<JJ> \<CC> \<FF> \<mu> by (rule \<mu>)
 
     show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
       if "u' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" for u' r'
     proof-
 
       interpret u': is_cat_cone \<alpha> r' \<JJ> \<CC> \<FF> u' by (rule that)
 
       let ?u' = \<open>\<lambda>j. u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>\<close> 
       let ?\<pi>' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Obj\<rparr>) ?R r' ?u'\<close>
 
       have \<pi>'_NTMap_app: "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
         using that 
         unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
         by auto
 
       have \<pi>': "?\<pi>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC> : :\<^sub>C (\<JJ>\<lparr>Obj\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         unfolding the_cat_discrete_components(1)
       proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
         show "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) ?R \<CC>"
         proof(intro tm_cf_discreteI)
           show "\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" if "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for i
             by (cs_concl cs_simp: cat_cs_simps cs_intro: that cat_cs_intros)
           show "category \<alpha> \<CC>" by (auto intro: cat_cs_intros)
           from \<FF>.tm_cf_ObjMap_in_Vset show "(\<lambda>x\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<FF>\<lparr>ObjMap\<rparr>\<lparr>x\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
             by (auto simp: \<FF>.cf_ObjMap_vdomain)
           show "(\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
           proof(rule vbrelation.vbrelation_Limit_in_VsetI)
             have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
             proof(intro vsubsetI)
               fix x assume "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>)"
               then obtain i where i: "i \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" 
                 and x_def: "x = \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>"
                 by auto
               from i have "x = \<FF>\<lparr>ArrMap\<rparr>\<lparr>\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr>\<rparr>"
                 by (simp add: x_def \<FF>.cf_ObjMap_CId)
               moreover from i have "\<JJ>\<lparr>CId\<rparr>\<lparr>i\<rparr> \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
                 by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
               ultimately show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>)"
                 by (auto intro: \<FF>.ArrMap.vsv_vimageI2)
             qed
             then show "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>\<JJ>\<lparr>Obj\<rparr>. \<CC>\<lparr>CId\<rparr>\<lparr>\<FF>\<lparr>ObjMap\<rparr>\<lparr>i\<rparr>\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"  
               by
                 (
                   auto simp: 
                     \<FF>.tm_cf_ArrMap_in_Vset vrange_in_VsetI vsubset_in_VsetI
                 )
           qed (auto intro: \<FF>.HomDom.tiny_cat_Obj_in_Vset)
         qed
         show "u'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>j\<rparr>" if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
           using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       qed (auto simp: cat_lim_cs_intros)
 
       from \<pi>\<^sub>O.cat_obj_prod_unique_cone'[OF this] obtain h' 
         where h': "h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
           and \<pi>'_NTMap_app': 
             "\<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
           and unique_h': "\<And>h''.
             \<lbrakk> 
               h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O;
               \<And>j. j \<in>\<^sub>\<circ> (\<JJ>\<lparr>Obj\<rparr>) \<Longrightarrow> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'' 
             \<rbrakk> \<Longrightarrow> h'' = h'"
         by metis
 
       interpret \<pi>':
         is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Obj\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Obj\<rparr>) (app (\<FF>\<lparr>ObjMap\<rparr>)) \<CC>\<close> ?\<pi>'
         by (rule \<pi>')
 
       let ?u'' = \<open>\<lambda>u. u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>u\<rparr>\<rparr>\<close> 
       let ?\<pi>'' = \<open>ntcf_obj_prod_base \<CC> (\<JJ>\<lparr>Arr\<rparr>) ?L r' ?u''\<close>
 
       have \<pi>''_NTMap_app: "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
         if "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" for f a b 
         using that 
         unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
         by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
       
       have \<pi>'': "?\<pi>'' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e :\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC> : :\<^sub>C (\<JJ>\<lparr>Arr\<rparr>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         unfolding the_cat_discrete_components(1)
       proof
         (
           intro 
             tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
             tm_cf_discrete
         )
         fix f assume "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>"
         then obtain a b where "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
         then show "u'\<lparr>NTMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr> : r' \<mapsto>\<^bsub>\<CC>\<^esub> \<FF>\<lparr>ObjMap\<rparr>\<lparr>\<JJ>\<lparr>Cod\<rparr>\<lparr>f\<rparr>\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       qed (simp add: cat_lim_cs_intros)
 
       from \<pi>\<^sub>A.cat_obj_prod_unique_cone'[OF this] obtain h'' 
         where h'': "h'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
           and \<pi>''_NTMap_app': 
             "\<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''"
           and unique_h'': "\<And>h'''.
             \<lbrakk> 
               h''' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A;
               \<And>j. j \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr> \<Longrightarrow> ?\<pi>''\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h''' 
             \<rbrakk> \<Longrightarrow> h''' = h''"
         by metis
 
       interpret \<pi>'': is_cat_cone \<alpha> r' \<open>:\<^sub>C (\<JJ>\<lparr>Arr\<rparr>)\<close> \<CC> \<open>:\<rightarrow>: (\<JJ>\<lparr>Arr\<rparr>) ?L \<CC>\<close> ?\<pi>''
         by (rule \<pi>'')
 
       have g'h'_f'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"  
       proof-
 
         from g' h' have g'h': "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         from f' h' have f'h': "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>A"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
         have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
           if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
         proof-
           from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
           then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
             by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
           also from f have "\<dots> = \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
             by 
               (
                 cs_concl 
                   cs_simp: \<pi>'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
               )
           also from f g' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')" 
             by 
               (
                 cs_concl
                   cs_simp: 
                     cat_cs_simps 
                     cat_discrete_cs_simps
                     the_cat_discrete_components(1) 
                     \<pi>'_NTMap_app'
                     \<pi>\<^sub>O_NTMap_app_Dom 
                   cs_intro: cat_cs_intros
               )
           finally show ?thesis by simp
         qed
           
         from unique_h''[OF g'h' this, simplified] have g'h'_h'': 
           "g' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
         have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
           if "f \<in>\<^sub>\<circ> \<JJ>\<lparr>Arr\<rparr>" for f
         proof-
           from that obtain a b where f: "f : a \<mapsto>\<^bsub>\<JJ>\<^esub> b" by auto
           then have "?\<pi>''\<lparr>NTMap\<rparr>\<lparr>f\<rparr> = u'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
             by (cs_concl cs_simp: \<pi>''_NTMap_app cat_cs_simps)
           also from f have "\<dots> = ?\<pi>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
             by (cs_concl cs_simp: \<pi>'_NTMap_app cs_intro: cat_cs_intros)
           also from f have "\<dots> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
             by (cs_concl cs_simp: \<pi>'_NTMap_app' cs_intro: cat_cs_intros)
           also from f g' h' have "\<dots> = (\<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f') \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'"
             by (cs_concl cs_simp: \<pi>\<^sub>O_NTMap_app_Cod cs_intro: cat_cs_intros)
           also from that f' h' have "\<dots> = \<pi>\<^sub>A\<lparr>NTMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')"
             by 
               (
                 cs_concl
                   cs_simp: cat_cs_simps the_cat_discrete_components(1) 
                   cs_intro: cat_cs_intros
                )
           finally show ?thesis by simp
         qed
         from unique_h''[OF f'h' this, simplified] have f'h'_h'': 
           "f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h' = h''".
         from g'h'_h'' f'h'_h'' show ?thesis by simp
       qed
 
       let ?II = \<open>\<up>\<up>\<^sub>C \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L\<close> 
         and ?II_II = \<open>\<up>\<up>\<rightarrow>\<up>\<up> \<CC> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f'\<close>
 
     define \<epsilon>' where "\<epsilon>' =
       [
         (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'))),
         cf_const ?II \<CC> r',
         ?II_II,
         ?II,
         \<CC>
       ]\<^sub>\<circ>"
 
     have \<epsilon>'_components: 
       "\<epsilon>'\<lparr>NTMap\<rparr> = (\<lambda>f\<in>\<^sub>\<circ>?II\<lparr>Obj\<rparr>. (f = \<aa>\<^sub>P\<^sub>L ? h' : (f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h')))"
       "\<epsilon>'\<lparr>NTDom\<rparr> = cf_const ?II \<CC> r'"
       "\<epsilon>'\<lparr>NTCod\<rparr> = ?II_II"
       "\<epsilon>'\<lparr>NTDGDom\<rparr> = ?II"
       "\<epsilon>'\<lparr>NTDGCod\<rparr> = \<CC>"
       unfolding \<epsilon>'_def nt_field_simps by (simp_all add: nat_omega_simps)
 
     have \<epsilon>'_NTMap_app_I2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = h'" if "x = \<aa>\<^sub>P\<^sub>L" for x 
     proof-
       have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
         unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
       then show ?thesis unfolding \<epsilon>'_components that by simp
     qed
 
     have \<epsilon>'_NTMap_app_sI2: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = f' \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> h'" if "x = \<bb>\<^sub>P\<^sub>L" for x 
     proof-      
       have "x \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>"
         unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
       with \<epsilon>.cat_parallel_\<aa>\<bb> show ?thesis
         unfolding \<epsilon>'_components by (cs_concl cs_simp: V_cs_simps that)
     qed
 
     interpret par: cf_parallel \<alpha> \<aa>\<^sub>P\<^sub>L \<bb>\<^sub>P\<^sub>L \<gg>\<^sub>P\<^sub>L \<ff>\<^sub>P\<^sub>L P\<^sub>O P\<^sub>A g' f' \<CC>
       by (intro cf_parallelI cat_parallelI)
         (
           simp_all add: 
             cat_cs_intros cat_parallel_cs_intros cat_PL_ineq[symmetric]
         )
 
     have "\<epsilon>' : r' <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
       show "vfsequence \<epsilon>'" unfolding \<epsilon>'_def by auto
       show "vcard \<epsilon>' = 5\<^sub>\<nat>" unfolding \<epsilon>'_def by (simp add: nat_omega_simps)
       from h' show "cf_const (?II) \<CC> r' : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       show "?II_II : ?II \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
         by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros)
       from h' show "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : 
         cf_const ?II \<CC> r'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>\<CC>\<^esub> ?II_II\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         if "a \<in>\<^sub>\<circ> ?II\<lparr>Obj\<rparr>" for a 
         using that
         by (elim the_cat_parallel_ObjE; simp only:)
           (
             cs_concl 
               cs_simp: 
                 \<epsilon>'_NTMap_app_I2 \<epsilon>'_NTMap_app_sI2 
                 cat_cs_simps cat_parallel_cs_simps 
               cs_intro: cat_cs_intros cat_parallel_cs_intros
           )
       from h' f' g'h'_f'h' show 
         "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> cf_const ?II \<CC> r'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
           ?II_II\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
           if "f : a \<mapsto>\<^bsub>?II\<^esub> b" for a b f
           using that
           by (elim \<epsilon>.the_cat_parallel_is_arrE; simp only:)
             (
               cs_concl 
                 cs_intro: cat_cs_intros cat_parallel_cs_intros 
                 cs_simp:
                   cat_cs_simps
                   cat_parallel_cs_simps
                   \<epsilon>'_NTMap_app_I2 
                   \<epsilon>'_NTMap_app_sI2
             )+
       qed 
         (
           simp add: \<epsilon>'_components | 
           cs_concl 
             cs_simp: cat_cs_simps 
             cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros 
         )+
     from \<epsilon>.cat_eq_unique_cone[OF this] obtain t'
       where t': "t' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E"
         and \<epsilon>'_NTMap_app: "\<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'"
         and unique_t':
           "\<lbrakk> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E; \<epsilon>'\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> = \<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t''\<rbrakk> \<Longrightarrow> 
             t'' = t'" 
         for t''
       by metis
 
     show "\<exists>!f'. f' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E \<and> u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> f'"
     proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
       show [symmetric, cat_cs_simps]: "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'"
       proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
         from t' show 
           "\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t' : cf_const \<JJ> \<CC> r' \<mapsto>\<^sub>C\<^sub>F \<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
           by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
         show "u'\<lparr>NTMap\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI)
           show "vsv ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           from t' show 
             "\<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>) = \<D>\<^sub>\<circ> ((\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>)"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
             if "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (u'\<lparr>NTMap\<rparr>)" for a
           proof-
             from that have "a \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" by (cs_prems cs_simp: cat_cs_simps)
             with t' show "u'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t')\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
               by 
                 (
                   cs_concl
                     cs_simp:
                       cat_cs_simps 
                       \<pi>'_NTMap_app
                       cat_parallel_cs_simps
                       the_cat_discrete_components(1)
                       \<epsilon>'_NTMap_app[symmetric]
                       \<epsilon>'_NTMap_app_I2
                       \<pi>'_NTMap_app'[symmetric]
                     cs_intro: cat_cs_intros cat_parallel_cs_intros
                 )
           qed
         qed auto
       qed simp_all
 
       fix t'' assume prems': 
         "t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> E" "u' = \<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t''"
       then have u'_NTMap_app_x:
         "u'\<lparr>NTMap\<rparr>\<lparr>x\<rparr> = (\<mu> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_const \<JJ> \<CC> t'')\<lparr>NTMap\<rparr>\<lparr>x\<rparr>"
         for x 
         by simp
       have "?\<pi>'\<lparr>NTMap\<rparr>\<lparr>j\<rparr> = \<pi>\<^sub>O\<lparr>NTMap\<rparr>\<lparr>j\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> (\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'')" 
         if "j \<in>\<^sub>\<circ> \<JJ>\<lparr>Obj\<rparr>" for j
         using u'_NTMap_app_x[of j] prems'(1) that
         by 
           (
             cs_prems 
               cs_simp:
                 cat_cs_simps 
                 cat_discrete_cs_simps 
                 cat_parallel_cs_simps 
                 the_cat_discrete_components(1) 
               cs_intro: cat_cs_intros cat_parallel_cs_intros
           ) 
           (simp add: \<pi>'_NTMap_app[OF that, symmetric])
       moreover from prems'(1) have "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' : r' \<mapsto>\<^bsub>\<CC>\<^esub> P\<^sub>O"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_parallel_cs_simps 
               cs_intro: cat_cs_intros cat_parallel_cs_intros
           )
       ultimately have [cat_cs_simps]: 
         "\<epsilon>\<lparr>NTMap\<rparr>\<lparr>\<aa>\<^sub>P\<^sub>L\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> t'' = h'" 
         by (intro unique_h') simp
       show "t'' = t'"
         by (rule unique_t', intro prems'(1)) 
           (cs_concl cs_simp: \<epsilon>'_NTMap_app_I2 cat_cs_simps)
       qed
     qed
  
   qed
   
   then show ?thesis using that by clarsimp
 
 qed
 
 lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
   \<comment>\<open>See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<FF> : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>\<aa> \<bb> \<gg> \<ff>. \<lbrakk> \<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>; \<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa> \<rbrakk> \<Longrightarrow>
       \<exists>E \<epsilon>. \<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A \<CC> \<Longrightarrow>
       \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<And>A. tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A \<CC> \<Longrightarrow>
       \<exists>P \<pi>. \<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
   obtains r u where "u : \<FF> >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m r : \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
 proof-
   interpret \<FF>: is_tm_functor \<alpha> \<JJ> \<CC> \<FF> by (rule assms(1))
   have "\<exists>E \<epsilon>. \<epsilon> : E <\<^sub>C\<^sub>F\<^sub>.\<^sub>e\<^sub>q (\<aa>,\<bb>,\<gg>,\<ff>) : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     if "\<ff> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" "\<gg> : \<bb> \<mapsto>\<^bsub>\<CC>\<^esub> \<aa>" for \<aa> \<bb> \<gg> \<ff>
   proof-
     from assms(2)[OF that(1,2)] obtain E \<epsilon> 
       where \<epsilon>: "\<epsilon> : (\<aa>,\<bb>,\<gg>,\<ff>) >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>e\<^sub>q E : \<up>\<up>\<^sup>2\<^sub>C \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by clarsimp
     interpret \<epsilon>: is_cat_coequalizer \<alpha> \<aa> \<bb> \<gg> \<ff> \<CC> E \<epsilon> by (rule \<epsilon>)
     from \<epsilon>.is_cat_equalizer_op[unfolded cat_op_simps] show ?thesis by auto
   qed
   moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Obj\<rparr>) A (op_cat \<CC>)" for A
   proof-
     interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
     from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi> 
       where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Obj\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by clarsimp 
     interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Obj\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
     from \<pi>.is_cat_obj_prod_op show ?thesis by auto
   qed
   moreover have "\<exists>P \<pi>. \<pi> : P <\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Prod> A : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     if "tm_cf_discrete \<alpha> (\<JJ>\<lparr>Arr\<rparr>) A (op_cat \<CC>)" for A 
   proof-
     interpret tm_cf_discrete \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<open>op_cat \<CC>\<close> by (rule that)
     from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P \<pi> 
       where \<pi>: "\<pi> : A >\<^sub>C\<^sub>F\<^sub>.\<^sub>\<Coprod> P : \<JJ>\<lparr>Arr\<rparr> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
       by clarsimp 
     interpret \<pi>: is_cat_obj_coprod \<alpha> \<open>\<JJ>\<lparr>Arr\<rparr>\<close> A \<CC> P \<pi> by (rule \<pi>)
     from \<pi>.is_cat_obj_prod_op show ?thesis by auto
   qed
   ultimately obtain u r where u: 
     "u : r <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<FF> : op_cat \<JJ> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<CC>"
     by 
       (
         rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
           OF \<FF>.is_tm_functor_op, unfolded cat_op_simps
           ]
       )
   interpret u: is_cat_limit \<alpha> \<open>op_cat \<JJ>\<close> \<open>op_cat \<CC>\<close> \<open>op_cf \<FF>\<close> r u by (rule u)
   from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
 qed
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
--- a/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
+++ b/thys/CZH_Universal_Constructions/czh_ucategories/CZH_UCAT_PWKan.thy
@@ -1,3452 +1,3623 @@
 (* Copyright 2021 (C) Mihails Milehins *)
 
 section\<open>Pointwise Kan extensions\<close>
 theory CZH_UCAT_PWKan
   imports CZH_UCAT_Kan
 begin
 
 
 
 subsection\<open>Pointwise Kan extensions\<close>
 
 
 text\<open>
 The following subsection is based on elements of the
 content of section 6.3 in \cite{riehl_category_2016} and
 Chapter X-5 in \cite{mac_lane_categories_2010}.
 \<close>
 
 locale is_cat_pw_rKe = is_cat_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>
   for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon> +
   assumes cat_pw_rKe_preserved: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
     \<epsilon> :
       \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
       \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) : \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
 
 syntax "_is_cat_pw_rKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (
     \<open>(_ :/ _ \<circ>\<^sub>C\<^sub>F _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<index> _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> 
     [51, 51, 51, 51, 51, 51, 51] 51
   )
 translations "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons> 
   "CONST is_cat_pw_rKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<GG> \<epsilon>"
 
 locale is_cat_pw_lKe = is_cat_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>
   for \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta> +
   assumes cat_pw_lKe_preserved: "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr> \<Longrightarrow>
     op_ntcf \<eta> :
       op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
       op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
 
 syntax "_is_cat_pw_lKe" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
   (
     \<open>(_ :/ _ \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<index> _ \<circ>\<^sub>C\<^sub>F _ :/ _ \<mapsto>\<^sub>C _ \<mapsto>\<^sub>C _)\<close> 
     [51, 51, 51, 51, 51, 51, 51] 51
   )
 translations "\<eta> : \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<FF> \<circ>\<^sub>C\<^sub>F \<KK> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>" \<rightleftharpoons> 
   "CONST is_cat_pw_lKe \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> \<FF> \<eta>"
 
 lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]: 
   assumes "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "\<AA>' = \<AA>"
     and "\<HH>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)"
     and "\<EE>' = cat_Set \<alpha>"
   shows "\<epsilon> : \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> : \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<EE>')"
   using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)
 
 lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'
 
 lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]: 
   assumes "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>"
     and "\<FF>' = op_cf \<FF>"
     and "\<KK>' = op_cf \<KK>"
     and "\<TT>' = op_cf \<TT>"
     and "\<BB>' = op_cat \<BB>"
     and "\<CC>' = op_cat \<CC>"
     and "\<AA>' = op_cat \<AA>"
     and "\<HH>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(-,a)"
     and "\<EE>' = cat_Set \<alpha>"
   shows "op_ntcf \<eta> :
     \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C (\<HH>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C \<EE>')"
   using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)
 
 lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'
 
 
 text\<open>Rules.\<close>
 
 lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<GG>' = \<GG>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
   shows "\<epsilon> : \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>'\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_pw_rKe_axioms)
 
 mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
   |intro is_cat_pw_rKeI|
   |dest is_cat_pw_rKeD[dest]|
   |elim is_cat_pw_rKeE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)
 
 lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
   assumes "\<alpha>' = \<alpha>"
     and "\<FF>' = \<FF>"
     and "\<KK>' = \<KK>"
     and "\<TT>' = \<TT>"
     and "\<BB>' = \<BB>"
     and "\<AA>' = \<AA>"
     and "\<CC>' = \<CC>"
   shows "\<eta> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>'\<^esub> \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_pw_lKe_axioms)
 
 mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
   |intro is_cat_pw_lKeI|
   |dest is_cat_pw_lKeD[dest]|
   |elim is_cat_pw_lKeE[elim]|
 
 lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)
 
 
 text\<open>Duality.\<close>
 
 lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
   "op_ntcf \<epsilon> :
     op_cf \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> op_cf \<GG> \<circ>\<^sub>C\<^sub>F op_cf \<KK> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
 proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
   fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   from cat_pw_rKe_preserved[OF prems] prems show
     "\<epsilon> :
       \<GG> \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
       \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<AA>(-,a) : \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
     by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
 qed (cs_concl cs_intro: cat_op_intros)
 
 lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<GG>' = op_cf \<GG>"
     and "\<KK>' = op_cf \<KK>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<epsilon> : \<TT>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<GG>' \<circ>\<^sub>C\<^sub>F \<KK>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_pw_lKe_op)
 
 lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'
 
 lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
   "op_ntcf \<eta> :
     op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
     op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C op_cat \<AA>"
 proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
   fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show 
     "op_ntcf \<eta> :
       op_cf \<FF> \<circ>\<^sub>C\<^sub>F op_cf \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> op_cf \<TT> :
       op_cat \<BB> \<mapsto>\<^sub>C op_cat \<CC> \<mapsto>\<^sub>C
       (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>op_cat \<AA>(a,-) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C cat_Set \<alpha>)"
     by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
 qed (cs_concl cs_intro: cat_op_intros)
 
 lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
   assumes "\<TT>' = op_cf \<TT>"
     and "\<FF>' = op_cf \<FF>"
     and "\<KK>' = op_cf \<KK>"
     and "\<BB>' = op_cat \<BB>"
     and "\<AA>' = op_cat \<AA>"
     and "\<CC>' = op_cat \<CC>"
   shows "op_ntcf \<eta> : \<FF>' \<circ>\<^sub>C\<^sub>F \<KK>' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^sub>.\<^sub>p\<^sub>w\<^bsub>\<alpha>\<^esub> \<TT>' : \<BB>' \<mapsto>\<^sub>C \<CC>' \<mapsto>\<^sub>C \<AA>'"
   unfolding assms by (rule is_cat_pw_rKe_op)
 
 lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'
 
 
 
 (*FIXME: any reason not to generalize and include in CZH_UCAT_Hom?*)
 subsection\<open>Cone functor\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition cf_Cone :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "cf_Cone \<alpha> \<beta> \<FF> = 
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>)(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F
     op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> (\<FF>\<lparr>HomDom\<rparr>) (\<FF>\<lparr>HomCod\<rparr>))"
 
 
 text\<open>An alternative form of the definition.\<close>
 
 context is_functor
 begin
 
 lemma cf_Cone_def': 
   "cf_Cone \<alpha> \<beta> \<FF> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) \<circ>\<^sub>C\<^sub>F op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)"
   unfolding cf_Cone_def cat_cs_simps by simp
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 lemma (in is_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
   shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>)"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms(2) show ?thesis
     unfolding cf_Cone_def
     by
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_intros] = is_functor.cf_Cone_ObjMap_vsv
 
 lemma (in is_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms show ?thesis
     unfolding cf_Cone_def'
     by
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ObjMap_vdomain
 
 lemma (in is_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> =
     Hom (cat_FUNCT \<alpha> \<AA> \<BB>) (cf_map (cf_const \<AA> \<BB> b)) (cf_map \<FF>)"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms(2,3) show ?thesis
     unfolding cf_Cone_def
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ObjMap_app
 
 
 subsubsection\<open>Arrow map\<close>
 
 lemma (in is_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
   shows "vsv (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>)"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms(2) show ?thesis
     unfolding cf_Cone_def
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_intros] = is_functor.cf_Cone_ArrMap_vsv
 
 lemma (in is_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>" and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms(2) show ?thesis
     unfolding cf_Cone_def'
     by
       (
         cs_concl 
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ArrMap_vdomain
 
 lemma (in is_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     and "f : a \<mapsto>\<^bsub>\<BB>\<^esub> b"
   shows "cf_Cone \<alpha> \<beta> \<FF>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_hom
     (cat_FUNCT \<alpha> \<AA> \<BB>)
     [ntcf_arrow (ntcf_const \<AA> \<BB> f), cat_FUNCT \<alpha> \<AA> \<BB>\<lparr>CId\<rparr>\<lparr>cf_map \<FF>\<rparr>]\<^sub>\<circ>"
 proof-
   from assms interpret \<beta>: \<Z> \<beta> by simp 
   from assms interpret \<Delta>: is_functor \<beta> \<BB> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from assms(2,3) show ?thesis
     unfolding cf_Cone_def
     by
       (
         cs_concl
           cs_simp: cat_cs_simps cat_FUNCT_components(1) cat_op_simps 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
       )
 qed
 
 lemmas [cat_Kan_cs_simps] = is_functor.cf_Cone_ArrMap_app
 
 
 subsubsection\<open>The cone functor is a functor\<close>
 
 lemma (in is_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
   assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
   shows "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
   from assms interpret \<AA>\<BB>: category \<beta> \<open>cat_FUNCT \<alpha> \<AA> \<BB>\<close>
     by
       (
         cs_concl cs_intro:
           cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )
   from assms interpret op_\<Delta>: 
     is_functor \<beta> \<open>op_cat \<BB>\<close> \<open>op_cat (cat_FUNCT \<alpha> \<AA> \<BB>)\<close> \<open>op_cf (\<Delta>\<^sub>C\<^sub>F \<alpha> \<AA> \<BB>)\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   have "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>cat_FUNCT \<alpha> \<AA> \<BB>(-,cf_map \<FF>) :
     op_cat (cat_FUNCT \<alpha> \<AA> \<BB>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     by
       (
         cs_concl
           cs_simp: cat_FUNCT_cs_simps 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
   then show "cf_Cone \<alpha> \<beta> \<FF> : op_cat \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     unfolding cf_Cone_def'
     by (cs_concl cs_intro: cat_cs_intros)
 qed
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_N\<close>\label{sec:lem_X_5_start}\<close>
 
 
 text\<open>
 This subsection and several further subsections 
 (\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
 expose definitions that are used in the proof of the technical lemma that
 was used in the proof of Theorem 3 from Chapter X-5
 in \cite{mac_lane_categories_2010}.
 \<close>
 
 definition L_10_5_N :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c =
     [
       (
         \<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
           cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet>
       ),
       (
         \<lambda>f\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>.
           cf_nt \<alpha> \<beta> \<KK>\<lparr>ArrMap\<rparr>\<lparr>
             ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>), \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>c\<rparr>
             \<rparr>\<^sub>\<bullet>
       ),
       op_cat (\<TT>\<lparr>HomCod\<rparr>),
       cat_Set \<beta>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_N_components:
   shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr> =
       (
         \<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>.
           cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet>
       )"
     and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr> =
       (
         \<lambda>f\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Arr\<rparr>.
           cf_nt \<alpha> \<beta> \<KK>\<lparr>ArrMap\<rparr>\<lparr>
             ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>), \<KK>\<lparr>HomCod\<rparr>\<lparr>CId\<rparr>\<lparr>c\<rparr>
             \<rparr>\<^sub>\<bullet>
       )"
     and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>HomDom\<rparr> = op_cat (\<TT>\<lparr>HomCod\<rparr>)"
     and "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>HomCod\<rparr> = cat_Set \<beta>"
   unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas L_10_5_N_components' = L_10_5_N_components[
     where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
     ]
 
 lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)
 
 end
 
 
 subsubsection\<open>Object map\<close>
 
 mk_VLambda L_10_5_N_components(1)
   |vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> c
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 mk_VLambda L_10_5_N_components'(1)[OF \<KK> \<TT>]
   |vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]|
   |app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]|
 
 end
 
 
 subsubsection\<open>Arrow map\<close>
 
 mk_VLambda L_10_5_N_components(2)
   |vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT> c
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 mk_VLambda L_10_5_N_components'(2)[OF \<KK> \<TT>]
   |vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]|
   |app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]|
 
 end
 
 
 subsubsection\<open>\<open>L_10_5_N\<close> is a functor\<close>
 
 lemma L_10_5_N_is_functor: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
 proof-
 
   let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))
 
   from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   
   interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
   from assms(2) interpret cf_nt: 
     is_functor \<beta> \<open>?FUNCT \<BB> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>cf_nt \<alpha> \<beta> \<KK>\<close>
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
   show ?thesis
   proof(intro is_functorI')
 
     show "vfsequence (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c)" unfolding L_10_5_N_def by simp
     show "vcard (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c) = 4\<^sub>\<nat>" 
       unfolding L_10_5_N_def by (simp add: nat_omega_simps)
     show "vsv (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>)" 
       by (cs_concl cs_intro: cat_Kan_cs_intros)
     from assms(3,4) show "vsv (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>)"
       by (cs_concl cs_intro: cat_Kan_cs_intros)
     from assms show "\<D>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
         )
     show "\<R>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
       unfolding L_10_5_N_components'[OF \<KK>.is_functor_axioms \<TT>.is_functor_axioms]
     proof(rule vrange_VLambda_vsubset)
       fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       from prems assms show
         "cf_nt \<alpha> \<beta> \<KK>\<lparr>ObjMap\<rparr>\<lparr>cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ>
           cat_Set \<beta>\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl
               cs_simp: cat_Set_components(1) cat_cs_simps  cat_FUNCT_cs_simps
               cs_intro: 
                 cat_cs_intros FUNCT_\<BB>.cat_Hom_in_Vset cat_FUNCT_cs_intros
           )
     qed
 
     from assms show "\<D>\<^sub>\<circ> (L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>"
       by 
         (
           cs_concl 
             cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
         )
 
     show "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> :
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
       using that assms
       unfolding cat_op_simps
       by 
         (
           cs_concl 
             cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app 
             cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
         )
 
     show 
       "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> =
         L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "g : b' \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c'" and "f : a' \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b'" for b' c' g a' f
     proof-
       from that assms(5) show ?thesis
         unfolding cat_op_simps
         by (*slow*)
           (
             cs_concl
               cs_intro:
                 cat_cs_intros
                 cat_prod_cs_intros
                 cat_FUNCT_cs_intros 
                 cat_op_intros
               cs_simp:
                 cat_cs_simps
                 cat_Kan_cs_simps
                 cat_FUNCT_cs_simps 
                 cat_prod_cs_simps 
                 cat_op_simps
                 cf_nt.cf_ArrMap_Comp[symmetric]
           )
     qed
 
     show 
       "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> =
         cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
       if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
     proof-
       note [cat_cs_simps] = 
         ntcf_id_cf_comp[symmetric] 
         ntcf_arrow_id_ntcf_id[symmetric]
         cat_FUNCT_CId_app[symmetric] 
       from that[unfolded cat_op_simps] assms show ?thesis
         by (*slow*)
           (
             cs_concl
               cs_intro:
                 cat_cs_intros
                 cat_FUNCT_cs_intros
                 cat_prod_cs_intros
                 cat_op_intros
               cs_simp: 
                 cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
           )
     qed
 
   qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
 
 qed
 
 lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]: 
   assumes "\<Z> \<beta>" 
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<AA>' = op_cat \<AA>"
     and "\<BB>' = cat_Set \<beta>"
     and "\<beta>' = \<beta>"
   shows "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>'\<^esub> \<BB>'"
   using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<upsilon>_arrow\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<upsilon>_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b =
     [
       (\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>). \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>),
       Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>),
       Hom (\<TT>\<lparr>HomCod\<rparr>) a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<upsilon>_arrow_components:
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrVal\<rparr> =
     (\<lambda>f\<in>\<^sub>\<circ>Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>). \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>)"
     and "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrDom\<rparr> = Hom (\<KK>\<lparr>HomCod\<rparr>) c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrCod\<rparr> = Hom (\<TT>\<lparr>HomCod\<rparr>) a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
   unfolding L_10_5_\<upsilon>_arrow_def arr_field_simps 
   by (simp_all add: nat_omega_simps) 
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas L_10_5_\<upsilon>_arrow_components' = L_10_5_\<upsilon>_arrow_components[
     where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
     ]
 
 lemmas [cat_Kan_cs_simps] = L_10_5_\<upsilon>_arrow_components'(2,3)
 
 end
 
 
 subsubsection\<open>Arrow value\<close>
 
 mk_VLambda L_10_5_\<upsilon>_arrow_components(1)
   |vsv L_10_5_\<upsilon>_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 mk_VLambda L_10_5_\<upsilon>_arrow_components'(1)[OF \<KK> \<TT>]
   |vdomain L_10_5_\<upsilon>_arrow_ArrVal_vdomain[cat_Kan_cs_simps]|
   |app L_10_5_\<upsilon>_arrow_ArrVal_app[unfolded in_Hom_iff]|
 
 end
 
 lemma L_10_5_\<upsilon>_arrow_ArrVal_app':
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> = \<tau>\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>"
 proof-
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   from assms(3) have c: "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>" by auto
   show ?thesis by (rule L_10_5_\<upsilon>_arrow_ArrVal_app[OF assms(1,2,3)])
 qed
 
 
 subsubsection\<open>\<open>L_10_5_\<upsilon>_arrow\<close> is an arrow\<close>
 
 lemma L_10_5_\<upsilon>_arrow_ArrVal_is_arr: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : a \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
 proof-
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(4))
   from assms(5,6) show ?thesis
     unfolding assms(3)
     by
       (
         cs_concl
           cs_simp:
             cat_cs_simps
             L_10_5_\<upsilon>_arrow_ArrVal_app
             cat_comma_cs_simps
             cat_FUNCT_cs_simps
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
 qed
 
 lemma L_10_5_\<upsilon>_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "a' = a"
     and "b' = \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "\<AA>' = \<AA>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> : a' \<mapsto>\<^bsub>\<AA>\<^esub> b'"
   using assms(1-3, 7-9) 
   unfolding assms(3-6) 
   by (rule L_10_5_\<upsilon>_arrow_ArrVal_is_arr)
 
 
 subsubsection\<open>Further elementary properties\<close>
 
 lemma L_10_5_\<upsilon>_arrow_is_arr: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b :
     Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
 proof-
   note L_10_5_\<upsilon>_arrow_components = L_10_5_\<upsilon>_arrow_components'[OF assms(1,2)]
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(5))
   show ?thesis
   proof(intro cat_Set_is_arrI)
     show "arr_Set \<alpha> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b)"
     proof(intro arr_SetI)
       show "vfsequence (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b)" 
         unfolding L_10_5_\<upsilon>_arrow_def by simp
       show "vcard (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b) = 3\<^sub>\<nat>"
         unfolding L_10_5_\<upsilon>_arrow_def by (simp add: nat_omega_simps)
       show 
         "\<R>\<^sub>\<circ> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ>
           L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrCod\<rparr>"
         unfolding L_10_5_\<upsilon>_arrow_components
       proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
         fix f assume "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         from L_10_5_\<upsilon>_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this 
         show "\<tau>'\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> : a \<mapsto>\<^bsub>\<AA>\<^esub> \<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           by 
             (
               cs_prems 
                 cs_simp: L_10_5_\<upsilon>_arrow_ArrVal_app' cat_cs_simps 
                 cs_intro: cat_cs_intros
             ) 
       qed
       from assms(3,6) show "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
         by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
       from assms(1-3,6) \<tau>.cat_cone_obj show
         "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b\<lparr>ArrCod\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
         by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
     qed (auto simp: L_10_5_\<upsilon>_arrow_components)
   qed (simp_all add: L_10_5_\<upsilon>_arrow_components)
 qed
 
 lemma L_10_5_\<upsilon>_arrow_is_arr'[cat_Kan_cs_intros]: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
     and "A = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "B = Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
     and "\<CC>' = cat_Set \<alpha>"
   shows "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b : A \<mapsto>\<^bsub>\<CC>'\<^esub> B"
   using assms(1-6) unfolding assms(7-9) by (rule L_10_5_\<upsilon>_arrow_is_arr)
 
 lemma L_10_5_\<upsilon>_cf_hom[cat_Kan_cs_simps]:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
     and "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'"
   shows 
     "L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
     cf_hom \<CC> [\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>, \<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> =
       cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>, \<TT>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
       L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau>' a a'"
     (is "?lhs = ?rhs")
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau> by (rule assms(5))
 
   have [cat_Kan_cs_simps]:
     "\<tau>\<lparr>NTMap\<rparr>\<lparr>a'', b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> = 
       \<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>"
     if F_def: "F = [[a', b', f']\<^sub>\<circ>, [a'', b'', f'']\<^sub>\<circ>, [g', h']\<^sub>\<circ>]\<^sub>\<circ>"
       and A_def: "A = [a', b', f']\<^sub>\<circ>"
       and B_def: "B = [a'', b'', f'']\<^sub>\<circ>"
       and F: "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B"
     for F A B a' b' f' a'' b'' f'' g' h'
   proof-
     from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
       and a''_def: "a'' = 0"
       and g'_def: "g' = 0"
       and h': "h' : b' \<mapsto>\<^bsub>\<BB>\<^esub> b''"
       and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
       and f'': "f'' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b''\<rparr>"
       and f''_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f' = f''"
       by auto
     from 
       \<tau>.ntcf_Comp_commute[OF F] 
       that(2) F g' h' f' f'' 
       \<KK>.is_functor_axioms 
       \<TT>.is_functor_axioms 
     show 
       "\<tau>\<lparr>NTMap\<rparr>\<lparr>a'', b'', \<KK>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f'\<rparr>\<^sub>\<bullet> = 
         \<TT>\<lparr>ArrMap\<rparr>\<lparr>h'\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<tau>\<lparr>NTMap\<rparr>\<lparr>a', b', f'\<rparr>\<^sub>\<bullet>"
       unfolding F_def A_def B_def a'_def a''_def g'_def 
       by (*slow*)
         (
           cs_prems
             cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
             cs_intro: cat_cs_intros cat_comma_cs_intros
         )
   qed
 
   from assms(3) assms(6,7) \<KK>.HomCod.category_axioms have lhs_is_arr:
     "?lhs : Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
     unfolding assms(4)
     by
       (
         cs_concl cs_simp: cs_intro:
           cat_lim_cs_intros 
           cat_cs_intros 
           cat_Kan_cs_intros 
           cat_prod_cs_intros 
           cat_op_intros
       )
   then have dom_lhs: "\<D>\<^sub>\<circ> ((?lhs)\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>)" 
     by (cs_concl cs_simp: cat_cs_simps)
   from assms(3) assms(6,7) \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms 
   have rhs_is_arr:
     "?rhs : Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
     unfolding assms(4)
     by
       (
         cs_concl cs_intro:
           cat_lim_cs_intros 
           cat_cs_intros 
           cat_Kan_cs_intros 
           cat_prod_cs_intros 
           cat_op_intros
       )
   then have dom_rhs: "\<D>\<^sub>\<circ> ((?rhs)\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>)" 
     by (cs_concl cs_simp: cat_cs_simps)
   show ?thesis
   proof(rule arr_Set_eqI)
     from lhs_is_arr show arr_Set_lhs: "arr_Set \<alpha> ?lhs"
       by (auto dest: cat_Set_is_arrD(1))
     from rhs_is_arr show arr_Set_rhs: "arr_Set \<alpha> ?rhs"
       by (auto dest: cat_Set_is_arrD(1))
     show "?lhs\<lparr>ArrVal\<rparr> = ?rhs\<lparr>ArrVal\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
       fix g assume prems: "g : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
       from prems assms(7) have \<KK>f: 
         "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> g : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>"
         by (cs_concl cs_intro: cat_cs_intros)
       with assms(6,7) prems \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms 
       show "?lhs\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?rhs\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
           by (*slow*)
             (
               cs_concl
                 cs_intro:
                   cat_lim_cs_intros 
                   cat_cs_intros 
                   cat_Kan_cs_intros
                   cat_comma_cs_intros
                   cat_prod_cs_intros 
                   cat_op_intros 
                   cat_1_is_arrI
                 cs_simp:
                   L_10_5_\<upsilon>_arrow_ArrVal_app' 
                   cat_cs_simps
                   cat_Kan_cs_simps
                   cat_op_simps
                   cat_FUNCT_cs_simps
                   cat_comma_cs_simps
                   assms(4)
             )+
     qed (use arr_Set_lhs arr_Set_rhs in auto)
   qed
     (
       use lhs_is_arr rhs_is_arr in
         \<open>cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros\<close>
     )+
 qed
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<tau>\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<tau> where "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a = 
   [
     (\<lambda>bf\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<upsilon>\<lparr>NTMap\<rparr>\<lparr>bf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>bf\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>),
     cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) a,
     \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>,
     c \<down>\<^sub>C\<^sub>F \<KK>,
     (\<TT>\<lparr>HomCod\<rparr>)
   ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<tau>_components: 
   shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTMap\<rparr> =
     (\<lambda>bf\<in>\<^sub>\<circ>c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>. \<upsilon>\<lparr>NTMap\<rparr>\<lparr>bf\<lparr>1\<^sub>\<nat>\<rparr>\<rparr>\<lparr>ArrVal\<rparr>\<lparr>bf\<lparr>2\<^sub>\<nat>\<rparr>\<rparr>)"
     and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDom\<rparr> = cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) (\<TT>\<lparr>HomCod\<rparr>) a"
     and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTCod\<rparr> = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
     and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDGDom\<rparr> = c \<down>\<^sub>C\<^sub>F \<KK>"
     and "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTDGCod\<rparr> = (\<TT>\<lparr>HomCod\<rparr>)"
   unfolding L_10_5_\<tau>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas L_10_5_\<tau>_components' = L_10_5_\<tau>_components[
   where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
   ]
 
 lemmas [cat_Kan_cs_simps] = L_10_5_\<tau>_components'(2-5)
 
 end
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda L_10_5_\<tau>_components(1)
   |vsv L_10_5_\<tau>_NTMap_vsv[cat_Kan_cs_intros]|
   |vdomain L_10_5_\<tau>_NTMap_vdomain[cat_Kan_cs_simps]|
 
 lemma L_10_5_\<tau>_NTMap_app[cat_Kan_cs_simps]: 
   assumes "bf = [0, b, f]\<^sub>\<circ>" and "bf \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" 
   shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> = \<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
   using assms unfolding L_10_5_\<tau>_components by (simp add: nat_omega_simps)
 
 
 subsubsection\<open>\<open>L_10_5_\<tau>\<close> is a cone\<close>
 
 lemma L_10_5_\<tau>_is_cat_cone[cat_cs_intros]:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and \<upsilon>'_def: "\<upsilon>' = ntcf_arrow \<upsilon>"
     and \<upsilon>: "\<upsilon> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
 
   let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close> 
   let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   from assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   from assms(3) interpret \<Pi>c: is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by
       (
         cs_concl
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
   interpret \<upsilon>: is_ntcf \<alpha> \<BB> \<open>cat_Set \<alpha>\<close> \<open>?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<open>?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>\<close> \<upsilon>
     by (rule \<upsilon>)
 
   show ?thesis
   proof(intro is_cat_coneI is_ntcfI')
     show "vfsequence (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a)" unfolding L_10_5_\<tau>_def by simp
     show "vcard (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a) = 5\<^sub>\<nat>" 
       unfolding L_10_5_\<tau>_def by (simp add: nat_omega_simps)
     from a interpret cf_const:
       is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<close> 
       by (cs_concl cs_intro: cat_cs_intros)
     show "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> :
       cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr>"
       if "bf \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>" for bf
     proof-
       from that assms(3) obtain b f 
         where bf_def: "bf = [0, b, f]\<^sub>\<circ>"
           and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
           and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by auto
       from \<upsilon>.ntcf_NTMap_is_arr[OF b] a b assms(3) f have "\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
         Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         by
           (
             cs_prems 
               cs_simp: cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros
           )
       with that b f show "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>bf\<rparr> :
         cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr> \<mapsto>\<^bsub>\<AA>\<^esub> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>bf\<rparr>"
         unfolding bf_def \<upsilon>'_def
         by
           (
             cs_concl
               cs_simp:
                 cat_cs_simps 
                 cat_Kan_cs_simps 
                 cat_comma_cs_simps
                 cat_FUNCT_cs_simps
               cs_intro: cat_cs_intros cat_comma_cs_intros
           )
     qed
 
     show 
       "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>B\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> =
         (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>F\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
       if "F : A \<mapsto>\<^bsub>c \<down>\<^sub>C\<^sub>F \<KK>\<^esub> B" for A B F
     proof-
       from \<KK>.is_functor_axioms that assms(3) obtain a' f a'' f' g 
         where F_def: "F = [[0, a', f]\<^sub>\<circ>, [0, a'', f']\<^sub>\<circ>, [0, g]\<^sub>\<circ>]\<^sub>\<circ>"
           and A_def: "A = [0, a', f]\<^sub>\<circ>"
           and B_def: "B = [0, a'', f']\<^sub>\<circ>"
           and g: "g : a' \<mapsto>\<^bsub>\<BB>\<^esub> a''"
           and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a'\<rparr>"
           and f': "f' : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>a''\<rparr>" 
           and f'_def: "\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f = f'" 
         by auto
       from \<upsilon>.ntcf_Comp_commute[OF g] have 
         "(\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a''\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
           ((?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> \<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>)\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
         by simp
       from this a g f f' \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms 
       have [cat_cs_simps]:
         "\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a''\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<KK>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<CC>\<^esub> f\<rparr> = 
           \<TT>\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>\<AA>\<^esub> \<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
         by (*slow*)
           (
             cs_prems
               cs_simp: cat_cs_simps cat_op_simps
               cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
           )
       from that a g f f' \<KK>.HomCod.category_axioms \<TT>.HomCod.category_axioms 
       show ?thesis
         unfolding F_def A_def B_def \<upsilon>'_def (*slow*)
         by
           (
             cs_concl
               cs_simp:
                 f'_def[symmetric] 
                 cat_cs_simps 
                 cat_Kan_cs_simps 
                 cat_comma_cs_simps 
                 cat_FUNCT_cs_simps
                 cat_op_simps 
               cs_intro: cat_cs_intros cat_op_intros
           )
     qed
 
   qed
     (
       use assms in
         \<open>
           cs_concl
             cs_simp: cat_cs_simps cat_Kan_cs_simps 
             cs_intro: cat_cs_intros cat_Kan_cs_intros a
         \<close>
     )+
 
 qed
 
 lemma L_10_5_\<tau>_is_cat_cone'[cat_Kan_cs_intros]:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<upsilon>' = ntcf_arrow \<upsilon>"
     and "\<FF>' = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
     and "c\<KK> = c \<down>\<^sub>C\<^sub>F \<KK>"
     and "\<AA>' = \<AA>"
     and "\<alpha>' = \<alpha>"
     and "\<upsilon> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
       \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<FF>' : c\<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<AA>'"
   using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_\<tau>_is_cat_cone)
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<upsilon>\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<upsilon> :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a =
     [
       (\<lambda>b\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b),
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>,
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>,
       \<TT>\<lparr>HomDom\<rparr>,
       cat_Set \<alpha>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<upsilon>_components: 
   shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTMap\<rparr> =
     (\<lambda>b\<in>\<^sub>\<circ>\<TT>\<lparr>HomDom\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<upsilon>_arrow \<TT> \<KK> c \<tau> a b)"
     and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDom\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<KK>\<lparr>HomCod\<rparr>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
     and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTCod\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<TT>\<lparr>HomCod\<rparr>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
     and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDGDom\<rparr> = \<TT>\<lparr>HomDom\<rparr>"
     and "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a\<lparr>NTDGCod\<rparr> = cat_Set \<alpha>"
   unfolding L_10_5_\<upsilon>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas L_10_5_\<upsilon>_components' = L_10_5_\<upsilon>_components[
   where \<TT>=\<TT> and \<KK>=\<KK>, unfolded cat_cs_simps
   ]
 
 lemmas [cat_Kan_cs_simps] = L_10_5_\<upsilon>_components'(2-5)
 
 end
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda L_10_5_\<upsilon>_components(1)
   |vsv L_10_5_\<upsilon>_NTMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<BB> \<CC> \<AA> \<KK> \<TT>
   assumes \<KK>: "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule \<KK>)
 interpretation \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 mk_VLambda L_10_5_\<upsilon>_components'(1)[OF \<KK> \<TT>]
   |vdomain L_10_5_\<upsilon>_NTMap_vdomain[cat_Kan_cs_simps]|
   |app L_10_5_\<upsilon>_NTMap_app[cat_Kan_cs_simps]|
 
 end
 
 
 subsubsection\<open>\<open>L_10_5_\<upsilon>\<close> is a natural transformation\<close>
 
 lemma L_10_5_\<upsilon>_is_ntcf:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and \<tau>'_def: "\<tau>' = ntcf_arrow \<tau>"
     and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     (is \<open>?L_10_5_\<upsilon> : ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>\<close>)
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>  
     by (rule assms(5))
 
   from assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   from assms(3) interpret \<Pi>c: is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by
       (
         cs_concl
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
 
   show "?L_10_5_\<upsilon> : ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
   proof(intro is_ntcfI')
     show "vfsequence ?L_10_5_\<upsilon>" unfolding L_10_5_\<upsilon>_def by auto
     show "vcard ?L_10_5_\<upsilon> = 5\<^sub>\<nat>" 
       unfolding L_10_5_\<upsilon>_def by (simp add: nat_omega_simps)
     show "?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
       (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr> \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b
     proof-
       from a that assms(3) show ?thesis
         unfolding \<tau>'_def
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_Kan_cs_simps
               cs_intro:
                 cat_Kan_cs_intros
                 cat_lim_cs_intros
                 cat_cs_intros
                 cat_op_intros
           )
     qed
     show
       "?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         (?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?L_10_5_\<upsilon>\<lparr>NTMap\<rparr>\<lparr>a'\<rparr>"
       if "f : a' \<mapsto>\<^bsub>\<BB>\<^esub> b'" for a' b' f
     proof-
       from that a assms(3) show ?thesis
         by
           (
             cs_concl
               cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps \<tau>'_def
               cs_intro: cat_lim_cs_intros cat_cs_intros 
           )
     qed
 
   qed
     (
       use assms(3,6) in
         \<open>
           cs_concl
             cs_simp: cat_cs_simps cat_Kan_cs_simps
             cs_intro: cat_cs_intros cat_Kan_cs_intros
         \<close>
     )+
 
 qed
 
 lemma L_10_5_\<upsilon>_is_ntcf'[cat_Kan_cs_intros]:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "\<tau>' = ntcf_arrow \<tau>"
     and "\<FF>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
     and "\<GG>' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
     and "\<BB>' = \<BB>"
     and "\<CC>' = cat_Set \<alpha>"
     and "\<alpha>' = \<alpha>"
     and "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<BB>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>'\<^esub> \<CC>'"
   using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_\<upsilon>_is_ntcf)
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>_arrow\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<chi>_arrow 
   where "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a =
     [
       (\<lambda>\<upsilon>\<in>\<^sub>\<circ>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>. ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a)), 
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<chi>_arrow_components: 
   shows "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr> = 
       (\<lambda>\<upsilon>\<in>\<^sub>\<circ>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>. ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon> a))"
     and "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrDom\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrCod\<rparr> = 
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
   unfolding L_10_5_\<chi>_arrow_def arr_field_simps
   by (simp_all add: nat_omega_simps)
 
 lemmas [cat_Kan_cs_simps] = L_10_5_\<chi>_arrow_components(2,3)
 
 
 subsubsection\<open>Arrow value\<close>
 
 mk_VLambda L_10_5_\<chi>_arrow_components(1)
   |vsv L_10_5_\<chi>_arrow_vsv[cat_Kan_cs_intros]|
   |vdomain L_10_5_\<chi>_arrow_vdomain|
   |app L_10_5_\<chi>_arrow_app|
 
 lemma L_10_5_\<chi>_arrow_vdomain'[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>) = Hom 
     (cat_FUNCT \<alpha> \<BB> (cat_Set \<alpha>)) 
     (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>)) 
     (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>))"
   using assms
   by
     (
       cs_concl 
         cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_\<chi>_arrow_vdomain 
         cs_intro: cat_cs_intros
     )
 
 lemma L_10_5_\<chi>_arrow_app'[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and \<upsilon>'_def: "\<upsilon>' = ntcf_arrow \<upsilon>"
     and \<upsilon>: "\<upsilon> :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows 
     "L_10_5_\<chi>_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<upsilon>'\<rparr> =
       ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>' a)"
   using assms
   by
     (
       cs_concl
         cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_\<chi>_arrow_app 
         cs_intro: cat_cs_intros cat_FUNCT_cs_intros
     )
 
 lemma \<upsilon>\<tau>a_def:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and \<upsilon>\<tau>a'_def: "\<upsilon>\<tau>a' = ntcf_arrow \<upsilon>\<tau>a"
     and \<upsilon>\<tau>a: "\<upsilon>\<tau>a :
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> :
       \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<upsilon>\<tau>a = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c (ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a' a)) a"
   (is \<open>\<upsilon>\<tau>a = ?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a\<close>)
 proof-
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   interpret \<upsilon>\<tau>a: is_ntcf 
     \<alpha> \<BB> \<open>cat_Set \<alpha>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>\<close> \<upsilon>\<tau>a
     by (rule \<upsilon>\<tau>a)
 
   show ?thesis
   proof(rule ntcf_eqI)
     show "\<upsilon>\<tau>a : 
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
       by (rule \<upsilon>\<tau>a)
     from assms(1-3) a show 
       "?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a :
         Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>" 
       by
         (
           cs_concl
             cs_simp: cat_Kan_cs_simps \<upsilon>\<tau>a'_def
             cs_intro: cat_cs_intros cat_Kan_cs_intros
         )
     have dom_lhs: "\<D>\<^sub>\<circ> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_cs_simps)
     have dom_rhs: "\<D>\<^sub>\<circ> (?L_10_5_\<upsilon> (ntcf_arrow (?L_10_5_\<tau>)) a\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
       by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
     show "\<upsilon>\<tau>a\<lparr>NTMap\<rparr> = ?L_10_5_\<upsilon> (ntcf_arrow ?L_10_5_\<tau>) a\<lparr>NTMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix b assume prems: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
       from prems assms(3) a have lhs: "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> :
         Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
           )
       then have dom_lhs: "\<D>\<^sub>\<circ> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>) = Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         by (cs_concl cs_simp: cat_cs_simps)
       from prems assms(3) a have rhs: 
         "L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b :
           Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>) \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         unfolding \<upsilon>\<tau>a'_def
         by
           (
             cs_concl 
               cs_simp: cat_Kan_cs_simps 
               cs_intro: cat_Kan_cs_intros cat_cs_intros
           )
 
       then have dom_rhs: 
         "\<D>\<^sub>\<circ> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c  (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>) =
           Hom \<CC> c (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)"
         by (cs_concl cs_simp: cat_cs_simps)
       have [cat_cs_simps]:  
         "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b"
       proof(rule arr_Set_eqI)
         from lhs show arr_Set_lhs: "arr_Set \<alpha> (\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>)"
           by (auto dest: cat_Set_is_arrD(1))
         from rhs show arr_Set_rhs: 
           "arr_Set \<alpha> (L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow (?L_10_5_\<tau>)) a b)"
           by (auto dest: cat_Set_is_arrD(1))
         show "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr> = 
           L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
           fix f assume "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
           with assms prems show 
             "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
               L_10_5_\<upsilon>_arrow \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a b\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>"
             unfolding \<upsilon>\<tau>a'_def
             by
               (
                 cs_concl
                   cs_simp:
                     cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_\<upsilon>_arrow_ArrVal_app 
                   cs_intro: cat_cs_intros cat_comma_cs_intros
               )
         qed (use arr_Set_lhs arr_Set_rhs in auto)
       qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
       from prems show 
         "\<upsilon>\<tau>a\<lparr>NTMap\<rparr>\<lparr>b\<rparr> = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c (ntcf_arrow ?L_10_5_\<tau>) a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>"
         by
           (
             cs_concl 
               cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
           )
 
     qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+
 
   qed simp_all
 
 qed
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>'_arrow\<close>\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<chi>'_arrow :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a =
     [
       (
         \<lambda>\<tau>\<in>\<^sub>\<circ>cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>.
           ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a)
       ),
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>,
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<chi>'_arrow_components:
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr> =
     (
       \<lambda>\<tau>\<in>\<^sub>\<circ>cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>.
         ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a)
     )"
     and [cat_Kan_cs_simps]: "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrDom\<rparr> =
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and [cat_Kan_cs_simps]: "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrCod\<rparr> =
        L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
   unfolding L_10_5_\<chi>'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
 
 
 subsubsection\<open>Arrow value\<close>
 
 mk_VLambda L_10_5_\<chi>'_arrow_components(1)
   |vsv L_10_5_\<chi>'_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
   |vdomain L_10_5_\<chi>'_arrow_ArrVal_vdomain|
   |app L_10_5_\<chi>'_arrow_ArrVal_app|
 
 lemma L_10_5_\<chi>'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "\<D>\<^sub>\<circ> (L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>) = Hom
     (cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>)
     (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) 
     (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>
     by (rule assms(3))
   from assms(1,2,4) show ?thesis
     by 
       (
         cs_concl
           cs_simp: cat_Kan_cs_simps L_10_5_\<chi>'_arrow_ArrVal_vdomain 
           cs_intro: cat_cs_intros
       )
 qed
 
 lemma L_10_5_\<chi>'_arrow_ArrVal_app'[cat_cs_simps]:
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and \<tau>'_def: "\<tau>' = ntcf_arrow \<tau>"
     and \<tau>: "\<tau> : a <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> =
     ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a)"
 proof-
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
   interpret \<tau>: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<tau>
     by (rule assms(4))
   from assms(2,5) have "\<tau>' \<in>\<^sub>\<circ> cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     unfolding \<tau>'_def
     by
       (
         cs_concl
           cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
           cs_intro: cat_FUNCT_cs_intros cat_cs_intros
       )
   then show
     "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> =
       ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a)"
     unfolding L_10_5_\<chi>'_arrow_components by auto
 qed
 
 
 subsubsection\<open>\<open>L_10_5_\<chi>'_arrow\<close> is an isomorphism in the category \<open>Set\<close>\<close>
 
 lemma L_10_5_\<chi>'_arrow_is_arr_isomorphism: 
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a :
     cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub>
     L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" (*FIXME: any reason not to evaluate ObjMap*)
     (
       is 
         \<open>
           ?L_10_5_\<chi>'_arrow :
             cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> 
             ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>
         \<close>
     )
 proof-
 
   let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
   let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
   let ?H_\<AA> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
 
   from assms(1,2) interpret \<beta>: \<Z> \<beta> by simp 
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))
 
   from \<KK>.vempty_is_zet assms interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   from assms(2,6) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
     by
       (
         cs_concl cs_intro:
           cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )
   from \<KK>.vempty_is_zet assms interpret \<Pi>c: 
     is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
 
   from assms(2) interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from assms(2) interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   
   have \<TT>\<Pi>: "\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     by (cs_concl cs_intro: cat_cs_intros)
 
   from assms(5,6) have [cat_cs_simps]: 
     "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) =
       cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a"
     "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)) = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
     "cf_of_cf_map \<BB> (cat_Set \<alpha>) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>)) = 
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-) \<circ>\<^sub>C\<^sub>F \<KK>"
     "cf_of_cf_map \<BB> (cat_Set \<alpha>) (cf_map (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>)) = 
       Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-) \<circ>\<^sub>C\<^sub>F \<TT>"
     by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
 
   note cf_Cone_ObjMap_app = is_functor.cf_Cone_ObjMap_app[OF \<TT>\<Pi> assms(1,2,6)]
 
   show ?thesis
   proof
     (
       intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI, 
       unfold L_10_5_\<chi>'_arrow_components(3) cf_Cone_ObjMap_app
     )
     show "vfsequence ?L_10_5_\<chi>'_arrow" 
       unfolding L_10_5_\<chi>'_arrow_def by auto
     show \<chi>'_arrow_ArrVal_vsv: "vsv (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)" 
       unfolding L_10_5_\<chi>'_arrow_components by auto
     show "vcard ?L_10_5_\<chi>'_arrow = 3\<^sub>\<nat>"
       unfolding L_10_5_\<chi>'_arrow_def by (simp add: nat_omega_simps)
     show [cat_cs_simps]: 
       "\<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) = ?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr>"
       unfolding L_10_5_\<chi>'_arrow_components by simp
     show vrange_\<chi>'_arrow_vsubset_N'': 
       "\<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) \<subseteq>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       unfolding L_10_5_\<chi>'_arrow_components
     proof(rule vrange_VLambda_vsubset)
       fix \<tau> assume prems: "\<tau> \<in>\<^sub>\<circ> cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       from this assms c\<KK>_\<AA>.category_axioms have \<tau>_is_arr:
         "\<tau> : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
         by
           (
             cs_prems
               cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_components(1)
               cs_intro: cat_cs_intros
           )
       note \<tau> = cat_FUNCT_is_arrD(1,2)[OF \<tau>_is_arr, unfolded cat_cs_simps]
       have "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)) = \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>"
         by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
       from prems assms \<tau>(1) show 
         "ntcf_arrow (L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau> a) \<in>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by (subst \<tau>(2)) (*slow*)
           (
             cs_concl
               cs_simp: cat_cs_simps cat_Kan_cs_simps
               cs_intro: 
                 is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
           )
     qed
 
     show "\<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) = ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     proof
       (
         intro vsubset_antisym[OF vrange_\<chi>'_arrow_vsubset_N''], 
         intro vsubsetI
       )
 
       fix \<upsilon>\<tau>a assume "\<upsilon>\<tau>a \<in>\<^sub>\<circ> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       from this assms have \<upsilon>\<tau>a:
         "\<upsilon>\<tau>a : cf_map (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>) \<mapsto>\<^bsub>?FUNCT \<BB>\<^esub> cf_map (?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>)"
         by 
           (
             cs_prems 
               cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
           )
       note \<upsilon>\<tau>a = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
       interpret \<tau>: 
         is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a\<close>
         by (rule L_10_5_\<tau>_is_cat_cone[OF assms(3,4,5) \<upsilon>\<tau>a(2,1) assms(6)])
 
       show "\<upsilon>\<tau>a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
       proof(rule vsv.vsv_vimageI2')
         show "vsv (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)" by (rule \<chi>'_arrow_ArrVal_vsv)
         from \<tau>.is_cat_cone_axioms assms show
           "ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a) \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
           by
             (
               cs_concl
                 cs_simp: cat_Kan_cs_simps 
                 cs_intro: cat_cs_intros cat_FUNCT_cs_intros
             )
         from assms \<upsilon>\<tau>a(1,2) show 
           "\<upsilon>\<tau>a = ?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>ntcf_arrow (L_10_5_\<tau> \<TT> \<KK> c \<upsilon>\<tau>a a)\<rparr>"
           by 
             (
               subst \<upsilon>\<tau>a(2), 
               cs_concl_step \<upsilon>\<tau>a_def[OF assms(3,4,5) \<upsilon>\<tau>a(2,1) assms(6)]  
             )
             (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       qed
     qed
 
     from assms show "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
       by 
         (
           cs_concl 
             cs_simp: cat_Kan_cs_simps cat_FUNCT_components(1) cf_Cone_ObjMap_app
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros c\<KK>_\<AA>.cat_Hom_in_Vset
         )
     with assms(2) have "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
       by (meson Vset_in_mono Vset_trans)
     from assms show "?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
       by
         (
           cs_concl
             cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps 
             cs_intro: cat_cs_intros FUNCT_\<BB>.cat_Hom_in_Vset cat_FUNCT_cs_intros
         )
     show dom_\<chi>'_arrow: "\<D>\<^sub>\<circ> (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>) =
       Hom ?c\<KK>_\<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
       unfolding L_10_5_\<chi>'_arrow_components cf_Cone_ObjMap_app by simp
     show "?L_10_5_\<chi>'_arrow\<lparr>ArrDom\<rparr> = 
       Hom ?c\<KK>_\<AA> (cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a)) (cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>))"
       unfolding L_10_5_\<chi>'_arrow_components cf_Cone_ObjMap_app by simp
     show "v11 (?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>)"
     proof(rule vsv.vsv_valeq_v11I, unfold dom_\<chi>'_arrow in_Hom_iff)
       fix \<tau>' \<tau>'' assume prems: 
         "\<tau>' : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
         "\<tau>'' : cf_map (cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
         "?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>\<tau>'\<rparr> = ?L_10_5_\<chi>'_arrow\<lparr>ArrVal\<rparr>\<lparr>\<tau>''\<rparr>"
       note \<tau>' = cat_FUNCT_is_arrD[OF prems(1), unfolded cat_cs_simps]
         and \<tau>'' = cat_FUNCT_is_arrD[OF prems(2), unfolded cat_cs_simps]
       interpret \<tau>': is_cat_cone 
         \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<close>
         by (rule is_cat_coneI[OF \<tau>'(1) assms(6)])
       interpret \<tau>'': is_cat_cone 
         \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<close>
         by (rule is_cat_coneI[OF \<tau>''(1) assms(6)])
       have \<tau>'\<tau>': "ntcf_arrow (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>') = \<tau>'"
         by (subst (2) \<tau>'(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
       have \<tau>''\<tau>'': "ntcf_arrow (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'') = \<tau>''"
         by (subst (2) \<tau>''(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
       from prems(3) \<tau>'(1) \<tau>''(1) assms have
         "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a = L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>'' a"
         by (subst (asm) \<tau>'(2), use nothing in \<open>subst (asm) \<tau>''(2)\<close>) (*slow*)
           (
             cs_prems 
               cs_simp: \<tau>'\<tau>' \<tau>''\<tau>'' cat_cs_simps cat_FUNCT_cs_simps 
               cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
           )
       from this have \<upsilon>\<tau>'a_\<upsilon>\<tau>''a: 
         "L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>' a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr> =
           L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c \<tau>'' a\<lparr>NTMap\<rparr>\<lparr>b\<rparr>\<lparr>ArrVal\<rparr>\<lparr>f\<rparr>" 
         if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" for b f
         by simp
       have [cat_cs_simps]: "\<tau>'\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet> = \<tau>''\<lparr>NTMap\<rparr>\<lparr>0, b, f\<rparr>\<^sub>\<bullet>"
         if "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" and "f : c \<mapsto>\<^bsub>\<CC>\<^esub> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>)" for b f
         using \<upsilon>\<tau>'a_\<upsilon>\<tau>''a[OF that] that
         by
           (
             cs_prems
               cs_simp: cat_Kan_cs_simps L_10_5_\<upsilon>_arrow_ArrVal_app
               cs_intro: cat_cs_intros 
           )
       have
         "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>' =
           ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''"
       proof(rule ntcf_eqI)
         show "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>' :
           cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a \<mapsto>\<^sub>C\<^sub>F \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
           by (rule \<tau>'.is_ntcf_axioms)
         then have dom_lhs: 
           "\<D>\<^sub>\<circ> (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps)
         show "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'' :
           cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> a \<mapsto>\<^sub>C\<^sub>F \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
           by (rule \<tau>''.is_ntcf_axioms)
         then have dom_rhs: 
           "\<D>\<^sub>\<circ> (ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>) = c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
           by (cs_concl cs_simp: cat_cs_simps)
         show
           "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr> =
             ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
           fix A assume "A \<in>\<^sub>\<circ> c \<down>\<^sub>C\<^sub>F \<KK>\<lparr>Obj\<rparr>"
           with assms(5) obtain b f 
             where A_def: "A = [0, b, f]\<^sub>\<circ>"
               and b: "b \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
               and f: "f : c \<mapsto>\<^bsub>\<CC>\<^esub> \<KK>\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
             by auto
           from b f show 
             "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>'\<lparr>NTMap\<rparr>\<lparr>A\<rparr> =
               ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> \<tau>''\<lparr>NTMap\<rparr>\<lparr>A\<rparr>"
             unfolding A_def 
             by (cs_concl cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
         qed (cs_concl cs_intro: V_cs_intros)+
       qed simp_all
       then show "\<tau>' = \<tau>''"
       proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
         show "\<tau>' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>"
           by (subst \<tau>'(2))
             (
               cs_concl cs_intro:
                 cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
             )
         show "\<tau>'' \<in>\<^sub>\<circ> ntcf_arrows \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>"
           by (subst \<tau>''(2))
             (
               cs_concl cs_intro: 
                 cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
             )
       qed
     qed (cs_concl cs_intro: cat_Kan_cs_intros)
 
   qed auto
 
 qed
 
 lemma L_10_5_\<chi>'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]: 
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "A = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "B = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<CC>' = cat_Set \<beta>"
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a : A \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>\<CC>'\<^esub> B"
   using assms(1-6)
   unfolding assms(7-9) 
   by (rule L_10_5_\<chi>'_arrow_is_arr_isomorphism)
 
 lemma L_10_5_\<chi>'_arrow_is_arr: 
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a :
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     by 
       (
         rule cat_Set_is_arr_isomorphismD(1)[
           OF L_10_5_\<chi>'_arrow_is_arr_isomorphism[OF assms(1-6)]
           ]
       )
 
 lemma L_10_5_\<chi>'_arrow_is_arr'[cat_Kan_cs_intros]: 
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
     and "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     and "A = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "B = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
     and "\<CC>' = cat_Set \<beta>"
   shows "L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a : A \<mapsto>\<^bsub>\<CC>'\<^esub> B"
   using assms(1-6) unfolding assms(7-9) by (rule L_10_5_\<chi>'_arrow_is_arr)
 
 
 
 subsection\<open>Lemma X.5: \<open>L_10_5_\<chi>\<close>\label{sec:lem_X_5_end}\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 definition L_10_5_\<chi> :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a),
       cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>),
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c,
       op_cat (\<TT>\<lparr>HomCod\<rparr>),
       cat_Set \<beta>
     ]\<^sub>\<circ>"
 
 
 text\<open>Components.\<close>
 
 lemma L_10_5_\<chi>_components: 
   shows "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTMap\<rparr> = 
     (\<lambda>a\<in>\<^sub>\<circ>\<TT>\<lparr>HomCod\<rparr>\<lparr>Obj\<rparr>. L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c a)"
     and [cat_Kan_cs_simps]: 
       "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDom\<rparr> = cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>)"
     and [cat_Kan_cs_simps]: 
       "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c"
     and "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDGDom\<rparr> = op_cat (\<TT>\<lparr>HomCod\<rparr>)"
     and [cat_Kan_cs_simps]: "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
   unfolding L_10_5_\<chi>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
 context
   fixes \<alpha> \<AA> \<BB> \<TT>
   assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 lemmas L_10_5_\<chi>_components' =
   L_10_5_\<chi>_components[where \<TT>=\<TT>, unfolded cat_cs_simps]
 
 lemmas [cat_Kan_cs_simps] = L_10_5_\<chi>_components'(4)
 
 end
 
 
 subsubsection\<open>Natural transformation map\<close>
 
 mk_VLambda L_10_5_\<chi>_components(1)
   |vsv L_10_5_\<chi>_NTMap_vsv[cat_Kan_cs_intros]|
 
 context
   fixes \<alpha> \<AA> \<BB> \<TT>
   assumes \<TT>: "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 begin
 
 interpretation is_functor \<alpha> \<BB> \<AA> \<TT> by (rule \<TT>)
 
 mk_VLambda L_10_5_\<chi>_components(1)[where \<TT>=\<TT>, unfolded cat_cs_simps]
   |vdomain L_10_5_\<chi>_NTMap_vdomain[cat_Kan_cs_simps]|
   |app L_10_5_\<chi>_NTMap_app[cat_Kan_cs_simps]|
 
 end
 
 
 subsubsection\<open>\<open>L_10_5_\<chi>\<close> is a natural isomorphism\<close>
 
 lemma L_10_5_\<chi>_is_iso_ntcf:
   \<comment>\<open>See lemma on page 245 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<Z> \<beta>"
     and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
     and "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c :
     cf_Cone \<alpha> \<beta> (\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o L_10_5_N \<alpha> \<beta> \<TT> \<KK> c :
     op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     (is \<open>?L_10_5_\<chi> : ?cf_Cone \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o ?L_10_5_N : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>\<close>)
 proof-
 
   let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
   let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?ntcf_c\<KK>_\<AA> = \<open>ntcf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?\<TT>_c\<KK> = \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
   let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
   let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
   let ?L_10_5_\<chi>'_arrow = \<open>L_10_5_\<chi>'_arrow \<alpha> \<beta> \<TT> \<KK> c\<close>
   let ?cf_c\<KK>_\<AA> = \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?L_10_5_\<upsilon> = \<open>L_10_5_\<upsilon> \<alpha> \<TT> \<KK> c\<close>
   let ?L_10_5_\<upsilon>_arrow = \<open>L_10_5_\<upsilon>_arrow \<TT> \<KK> c\<close>
 
   interpret \<beta>: \<Z> \<beta> by (rule assms(1))
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(3))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(4))
 
   from \<KK>.vempty_is_zet assms(5) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   from assms(1,2,5) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
     by
       (
         cs_concl cs_intro:
           cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )
   interpret \<beta>_c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
     by (cs_concl cs_intro: cat_cs_intros assms(2))+
   from assms(2,5) interpret \<Delta>: is_functor \<beta> \<AA> ?c\<KK>_\<AA> \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from \<KK>.vempty_is_zet assms(5) interpret \<Pi>c: 
     is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by
       (
         cs_concl
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
   interpret \<beta>\<Pi>c: is_tiny_functor \<beta> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by (rule \<Pi>c.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])
   
   interpret E: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>cf_eval \<alpha> \<beta> \<CC>\<close>
     by (rule \<KK>.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])
 
   from assms(2) interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from assms(2) interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from assms(2) interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   
   interpret \<beta>\<AA>: tiny_category \<beta> \<AA>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_simp: cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: tiny_category \<beta> \<BB>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_simp: cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<CC>: tiny_category \<beta> \<CC>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_simp: cs_intro: cat_cs_intros\<close>)+
 
   interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_simp: cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use assms(2) in \<open>cs_concl cs_simp: cs_intro: cat_cs_intros\<close>)+
 
   interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
     by (rule \<KK>.subcategory_cat_Set_cat_Set[OF assms(1,2)])
   
   show ?thesis
   proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)
 
     show "vfsequence (?L_10_5_\<chi>)" unfolding L_10_5_\<chi>_def by auto
     show "vcard (?L_10_5_\<chi>) = 5\<^sub>\<nat>" 
       unfolding L_10_5_\<chi>_def by (simp add: nat_omega_simps)
     from assms(2) show "?cf_Cone : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>" 
       by (intro is_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
         (cs_concl cs_intro: cat_cs_intros)+
 
     from assms show "?L_10_5_N : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>" 
       by (cs_concl cs_intro: cat_Kan_cs_intros)
     show "?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : 
       ?cf_Cone\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a 
       using assms(2,3,4,5) that
       by
         (
           cs_concl 
             cs_simp: L_10_5_\<chi>_NTMap_app 
             cs_intro: cat_cs_intros L_10_5_\<chi>'_arrow_is_arr_isomorphism
          )
     from cat_Set_is_arr_isomorphismD[OF this] show 
       "?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : ?cf_Cone\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
       using that by auto
 
     have [cat_cs_simps]:
       "?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub>
         cf_hom ?c\<KK>_\<AA> [ntcf_arrow (?ntcf_c\<KK>_\<AA> f), ntcf_arrow (ntcf_id ?\<TT>_c\<KK>)]\<^sub>\<circ> =
         cf_hom (?FUNCT \<BB>)
           [
             ntcf_arrow (ntcf_id (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)),
             ntcf_arrow (Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>)
           ]\<^sub>\<circ> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a"
       (
         is 
           "?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs =
             ?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a"
       )
       if "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" for a b f
     proof-
       let ?H_f = \<open>Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-)\<close>
       from that assms c\<KK>_\<AA>.category_axioms c\<KK>_\<AA>.category_axioms have lhs:
         "?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs :
           Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
           ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by (*slow*)
           (
             cs_concl
               cs_simp:
                 cat_Kan_cs_simps
                 cat_cs_simps
                 cat_FUNCT_cs_simps
                 cat_FUNCT_components(1)
                 cat_op_simps
               cs_intro:
                 cat_Kan_cs_intros
                 cat_FUNCT_cs_intros
                 cat_cs_intros
                 cat_prod_cs_intros
                 cat_op_intros
           )
       then have dom_lhs:
         "\<D>\<^sub>\<circ> ((?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>) =
           Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>)"
         by (cs_concl cs_simp: cat_cs_simps)
       from that assms c\<KK>_\<AA>.category_axioms c\<KK>_\<AA>.category_axioms have rhs:
         "?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a :
           Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>) \<mapsto>\<^bsub>cat_Set \<beta>\<^esub>
           ?L_10_5_N\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
         by (*slow*)
           (
             cs_concl
               cs_simp: 
                 cat_Kan_cs_simps 
                 cat_cs_simps
                 cat_FUNCT_components(1)
                 cat_op_simps
               cs_intro:
                 cat_Kan_cs_intros
                 cat_cs_intros
                 cat_prod_cs_intros
                 cat_FUNCT_cs_intros
                 cat_op_intros
           )
       then have dom_rhs:
         "\<D>\<^sub>\<circ> ((?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>) =
           Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> a)) (cf_map ?\<TT>_c\<KK>)"
         by (cs_concl cs_simp: cat_cs_simps)
 
       show ?thesis
       proof(rule arr_Set_eqI)
         from lhs show arr_Set_lhs: 
           "arr_Set \<beta> (?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)"
           by (auto dest: cat_Set_is_arrD(1))
         from rhs show arr_Set_rhs:
           "arr_Set \<beta> (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)"
           by (auto dest: cat_Set_is_arrD(1))
         show 
           "(?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr> =
             (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>"
         proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
           fix F assume prems: "F : cf_map (?cf_c\<KK>_\<AA> a) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map ?\<TT>_c\<KK>"
           let ?F = \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> F\<close>
           from that have [cat_cs_simps]:
             "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (?cf_c\<KK>_\<AA> a)) = ?cf_c\<KK>_\<AA> a"
             "cf_of_cf_map (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> (cf_map (?\<TT>_c\<KK>)) = ?\<TT>_c\<KK>"
             by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
           note F = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
           from that F(1) have F_const_is_cat_cone:
             "?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f : b <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
             by
               (
                 cs_concl
                   cs_simp: cat_cs_simps cs_intro: is_cat_coneI cat_cs_intros
               )
           have [cat_cs_simps]:
             "?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b =
               ?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a"
           proof(rule ntcf_eqI)
             from assms that F(1) show
               "?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b :
                 ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> b \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
               by
                 (
                   cs_concl cs_intro:
                     cat_Kan_cs_intros cat_cs_intros is_cat_coneI
                 )
             then have dom_\<upsilon>: 
               "\<D>\<^sub>\<circ> (?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr>) = 
                 \<BB>\<lparr>Obj\<rparr>"
               by (cs_concl cs_simp: cat_cs_simps)
             from assms that F(1) show 
               "?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a :
                 ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F ?H_\<AA> b \<circ>\<^sub>C\<^sub>F \<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
               by
                 (
                   cs_concl cs_intro:
                     cat_Kan_cs_intros cat_cs_intros is_cat_coneI
                 )
             then have dom_f\<TT>\<upsilon>:
               "\<D>\<^sub>\<circ> ((?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>) =
                 \<BB>\<lparr>Obj\<rparr>"
               by (cs_concl cs_simp: cat_cs_simps)
             show 
               "?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr> =
                 (?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>"
             proof(rule vsv_eqI, unfold dom_\<upsilon> dom_f\<TT>\<upsilon>)
               fix b' assume prems': "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
               let ?Y = \<open>Yoneda_component (?H_\<AA> b) a f (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)\<close>
               let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
               let ?\<TT>b' = \<open>\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
               have [cat_cs_simps]:
                 "?L_10_5_\<upsilon>_arrow (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b b' =
                   ?Y \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?L_10_5_\<upsilon>_arrow (ntcf_arrow ?F) a b'"
                 (is \<open>?\<upsilon>_Ffbb' = ?Y\<upsilon>\<close>)
               proof-
                 from assms prems' F_const_is_cat_cone have \<upsilon>_Ffbb': 
                   "?\<upsilon>_Ffbb' : Hom \<CC> c ?\<KK>b' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b ?\<TT>b'"
                   by 
                     (
                       cs_concl cs_intro:
                         cat_cs_intros L_10_5_\<upsilon>_arrow_is_arr
                     )
                 then have dom_\<upsilon>_Ffbb': "\<D>\<^sub>\<circ> (?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr>) = Hom \<CC> c (?\<KK>b')"
                   by (cs_concl cs_simp: cat_cs_simps)
                 from assms that \<TT>.HomCod.category_axioms prems' F(1) have Y\<upsilon>:
                   "?Y\<upsilon> : Hom \<CC> c ?\<KK>b' \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b ?\<TT>b'"
                   by
                     (
                       cs_concl
                         cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
                         cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                     )
                 then have dom_Y\<upsilon>: "\<D>\<^sub>\<circ> (?Y\<upsilon>\<lparr>ArrVal\<rparr>) = Hom \<CC> c (?\<KK>b')"
                   by (cs_concl cs_simp: cat_cs_simps)
                 show ?thesis
                 proof(rule arr_Set_eqI)
                   from \<upsilon>_Ffbb' show arr_Set_\<upsilon>_Ffbb': "arr_Set \<alpha> ?\<upsilon>_Ffbb'"
                     by (auto dest: cat_Set_is_arrD(1))
                   from Y\<upsilon> show arr_Set_Y\<upsilon>: "arr_Set \<alpha> ?Y\<upsilon>"
                     by (auto dest: cat_Set_is_arrD(1))
                   show "?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr> = ?Y\<upsilon>\<lparr>ArrVal\<rparr>"
                   proof(rule vsv_eqI, unfold dom_\<upsilon>_Ffbb' dom_Y\<upsilon> in_Hom_iff)
                     fix g assume "g : c \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
                     with 
                       assms(2-) 
                       \<KK>.is_functor_axioms 
                       \<TT>.is_functor_axioms 
                       \<TT>.HomCod.category_axioms 
                       \<KK>.HomCod.category_axioms 
                       that prems' F(1) 
                     show "?\<upsilon>_Ffbb'\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?Y\<upsilon>\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
                       by (*slow*)
                         (
                           cs_concl
                             cs_simp:
                               cat_Kan_cs_simps
                               cat_cs_simps
                               L_10_5_\<upsilon>_arrow_ArrVal_app
                               cat_comma_cs_simps
                               cat_op_simps
                             cs_intro: 
                               cat_Kan_cs_intros 
                               is_cat_coneI 
                               cat_cs_intros 
                               cat_comma_cs_intros
                               cat_op_intros 
                             cs_simp: cat_FUNCT_cs_simps
                         )
                   qed (use arr_Set_\<upsilon>_Ffbb' arr_Set_Y\<upsilon> in auto)
                 qed (use \<upsilon>_Ffbb' Y\<upsilon> in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
               qed
 
               from assms prems' that F(1) show
                 "?L_10_5_\<upsilon> (ntcf_arrow (?F \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?ntcf_c\<KK>_\<AA> f)) b\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> =
                   (?H_f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?L_10_5_\<upsilon> (ntcf_arrow ?F) a)\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
                 by
                   (
                     cs_concl
                       cs_simp: cat_Kan_cs_simps cat_cs_simps
                       cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                   )
 
             qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+
 
           qed simp_all
 
           from that F(1) interpret F: is_cat_cone \<alpha> a \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<AA> \<open>?\<TT>_c\<KK>\<close> ?F
             by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
           from
             assms(2-) prems F(1) that
             \<TT>.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that] (*speedup*)
             c\<KK>_\<AA>.category_axioms (*speedup*)
           show 
             "(?L_10_5_\<chi>'_arrow b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>\<lparr>F\<rparr> =
               (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>'_arrow a)\<lparr>ArrVal\<rparr>\<lparr>F\<rparr>"
             by (subst (1 2) F(2)) (*exceptionally slow*)
             (
               cs_concl
                 cs_simp: 
                   cat_cs_simps 
                   cat_Kan_cs_simps
                   cat_FUNCT_cs_simps 
                   cat_FUNCT_components(1) 
                   cat_op_simps 
                 cs_intro: 
                   is_cat_coneI 
                   cat_Kan_cs_intros
                   cat_cs_intros 
                   cat_prod_cs_intros 
                   cat_FUNCT_cs_intros 
                   cat_op_intros
             )
         qed (use arr_Set_lhs arr_Set_rhs in auto)
 
       qed (use lhs rhs in \<open>cs_concl cs_simp: cat_cs_simps\<close>)+
 
     qed
 
     show 
       "?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_Cone\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         ?L_10_5_N\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?L_10_5_\<chi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       if "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" for a b f
       using that assms
       by
         (
           cs_concl
             cs_simp:
               cat_cs_simps
               cat_Kan_cs_simps
               cat_FUNCT_components(1)
               cat_FUNCT_cs_simps
               cat_op_simps
             cs_intro: 
               cat_Kan_cs_intros
               cat_cs_intros
               cat_FUNCT_cs_intros
               cat_op_intros
         )
 
   qed 
     (
       cs_concl
         cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
     )+
 
 qed
 
 
 
 subsection\<open>
-The limit of \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close> exists for every 
-pointwise right Kan extension of \<open>\<TT>\<close> along \<open>\<KK>\<close>
+The existence of a canonical limit or a canonical colimit for the
+pointwise Kan extensions
 \<close>
 
 lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
-  \<comment>\<open>Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.
-    The size conditions for the functors \<open>\<KK>\<close> and \<open>\<TT>\<close> are related to the
-    choice of the definition of the limit in this work (by definition,
-    all limits are small).\<close>
+  \<comment>\<open>Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
     and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   obtains UA 
     where "UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
 
   define \<beta> where "\<beta> = \<alpha> + \<omega>"
   have \<beta>: "\<Z> \<beta>" and \<alpha>\<beta>: "\<alpha> \<in>\<^sub>\<circ> \<beta>" 
     by (simp_all add: \<beta>_def AG.\<Z>_Limit_\<alpha>\<omega> AG.\<Z>_\<omega>_\<alpha>\<omega> \<Z>_def AG.\<Z>_\<alpha>_\<alpha>\<omega>)
   then interpret \<beta>: \<Z> \<beta> by simp 
 
   let ?FUNCT = \<open>\<lambda>\<AA>. cat_FUNCT \<alpha> \<AA> (cat_Set \<alpha>)\<close>
   let ?H_A = \<open>\<lambda>f. Hom\<^sub>A\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(f,-)\<close>
   let ?H_A\<GG> = \<open>\<lambda>f. ?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<GG>\<close>
   let ?H_\<AA> = \<open>\<lambda>a. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<AA>(a,-)\<close>
   let ?H_\<AA>\<TT> = \<open>\<lambda>a. ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<TT>\<close>
   let ?H_\<AA>\<GG> = \<open>\<lambda>a. ?H_\<AA> a \<circ>\<^sub>C\<^sub>F \<GG>\<close>
   let ?H_\<CC> = \<open>\<lambda>c. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<alpha>\<^esub>\<CC>(c,-)\<close>
   let ?H_\<CC>\<KK> = \<open>\<lambda>c. ?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>\<close>
   let ?H_\<AA>\<epsilon> = \<open>\<lambda>b. ?H_\<AA> b \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<epsilon>\<close>
   let ?SET_\<KK> = \<open>exp_cat_cf \<alpha> (cat_Set \<alpha>) \<KK>\<close>
   let ?H_FUNCT = \<open>\<lambda>\<CC> \<FF>. Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>?FUNCT \<CC>(-,cf_map \<FF>)\<close>
   let ?ua_NTDGDom = \<open>op_cat (?FUNCT \<CC>)\<close>
   let ?ua_NTDom = \<open>\<lambda>a. ?H_FUNCT \<CC> (?H_\<AA>\<GG> a)\<close>
   let ?ua_NTCod = \<open>\<lambda>a. ?H_FUNCT \<BB> (?H_\<AA>\<TT> a) \<circ>\<^sub>C\<^sub>F op_cf ?SET_\<KK>\<close>
   let ?c\<KK>_\<AA> = \<open>cat_FUNCT \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?ua = 
     \<open>
       \<lambda>a. ntcf_ua_fo
         \<beta>
         ?SET_\<KK>
         (cf_map (?H_\<AA>\<TT> a))
         (cf_map (?H_\<AA>\<GG> a))
         (ntcf_arrow (?H_\<AA>\<epsilon> a))
     \<close>
   let ?cf_nt = \<open>cf_nt \<alpha> \<beta> (cf_id \<CC>)\<close>
   let ?cf_eval = \<open>cf_eval \<alpha> \<beta> \<CC>\<close>
   let ?\<TT>_c\<KK> = \<open>\<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
   let ?cf_c\<KK>_\<AA> = \<open>cf_const (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?\<GG>c = \<open>\<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>\<close>
   let ?\<Delta> = \<open>\<Delta>\<^sub>C\<^sub>F \<alpha> (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA>\<close>
   let ?ntcf_ua_fo = 
     \<open>
       \<lambda>a. ntcf_ua_fo
         \<beta> 
         ?SET_\<KK> 
         (cf_map (?H_\<AA>\<TT> a)) 
         (cf_map (?H_\<AA>\<GG> a)) 
         (ntcf_arrow (?H_\<AA>\<epsilon> a))
     \<close>
   let ?umap_fo =
     \<open>
       \<lambda>b. umap_fo
         ?SET_\<KK>
         (cf_map (?H_\<AA>\<TT> b))
         (cf_map (?H_\<AA>\<GG> b))
         (ntcf_arrow (?H_\<AA>\<epsilon> b))
         (cf_map (?H_\<CC> c))
     \<close>
 
   interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
 
   from AG.vempty_is_zet assms(3) interpret c\<KK>: category \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close>
     by (cs_concl cs_intro: cat_comma_cs_intros)
   from \<alpha>\<beta> assms(3) interpret c\<KK>_\<AA>: category \<beta> ?c\<KK>_\<AA>
     by
       (
         cs_concl cs_intro:
           cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
       )
   from \<alpha>\<beta> assms(3) interpret \<Delta>: is_functor \<beta> \<AA> ?c\<KK>_\<AA> ?\<Delta>
     by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
   from AG.vempty_is_zet assms(3) interpret \<Pi>c: 
     is_functor \<alpha> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by
       (
         cs_concl
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
 
   interpret \<beta>\<Pi>c: is_tiny_functor \<beta> \<open>c \<down>\<^sub>C\<^sub>F \<KK>\<close> \<BB> \<open>c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK>\<close>
     by (rule \<Pi>c.cf_is_tiny_functor_if_ge_Limit[OF \<beta> \<alpha>\<beta>])
   
   interpret E: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> ?cf_eval
     by (rule AG.HomCod.cat_cf_eval_is_functor[OF \<beta> \<alpha>\<beta>])
 
   from \<alpha>\<beta> interpret FUNCT_\<AA>: tiny_category \<beta> \<open>?FUNCT \<AA>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from \<alpha>\<beta> interpret FUNCT_\<BB>: tiny_category \<beta> \<open>?FUNCT \<BB>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   from \<alpha>\<beta> interpret FUNCT_\<CC>: tiny_category \<beta> \<open>?FUNCT \<CC>\<close>
     by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
   
   interpret \<beta>\<AA>: tiny_category \<beta> \<AA>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<BB>: tiny_category \<beta> \<BB>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<CC>: tiny_category \<beta> \<CC>
     by (rule category.cat_tiny_category_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
   interpret \<beta>\<KK>: is_tiny_functor \<beta> \<BB> \<CC> \<KK>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<GG>: is_tiny_functor \<beta> \<CC> \<AA> \<GG>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
   interpret \<beta>\<TT>: is_tiny_functor \<beta> \<BB> \<AA> \<TT>
     by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
       (use \<alpha>\<beta> in \<open>cs_concl cs_intro: cat_cs_intros\<close>)+
 
   interpret cat_Set_\<alpha>\<beta>: subcategory \<beta> \<open>cat_Set \<alpha>\<close> \<open>cat_Set \<beta>\<close>
     by (rule AG.subcategory_cat_Set_cat_Set[OF \<beta> \<alpha>\<beta>])
 
   from assms(3) \<alpha>\<beta> interpret Hom_c: is_functor \<alpha> \<CC> \<open>cat_Set \<alpha>\<close> \<open>?H_\<CC> c\<close> 
     by (cs_concl cs_intro: cat_cs_intros)
 
   (** E' **)
 
   define E' :: V where "E' =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
       (\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>),
       op_cat \<AA>,
       cat_Set \<beta>
     ]\<^sub>\<circ> "
 
   have E'_components:
     "E'\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
     "E'\<lparr>ArrMap\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>)"
     "E'\<lparr>HomDom\<rparr> = op_cat \<AA>"
     "E'\<lparr>HomCod\<rparr> = cat_Set \<beta>"
     unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
   note [cat_cs_simps] = E'_components(3,4)
   
   have E'_ObjMap_app[cat_cs_simps]: 
     "E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = ?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>"
     if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
     using that unfolding E'_components by simp
   have E'_ArrMap_app[cat_cs_simps]: 
     "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = ?cf_eval\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>"
     if "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" for f
     using that unfolding E'_components by simp
 
   have E': "E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
   proof(intro is_functorI')
 
     show "vfsequence E'" unfolding E'_def by auto
     show "vcard E' = 4\<^sub>\<nat>" unfolding E'_def by (simp add: nat_omega_simps)
     show "vsv (E'\<lparr>ObjMap\<rparr>)" unfolding E'_components by simp
     show "vsv (E'\<lparr>ArrMap\<rparr>)" unfolding E'_components by simp
     show "\<D>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
       unfolding E'_components by (simp add: cat_op_simps)
     show "\<R>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
       unfolding E'_components
     proof(rule vrange_VLambda_vsubset)
       fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       then have "?H_\<AA>\<GG> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       with assms(3) prems show 
         "?cf_eval\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl
               cs_simp: cat_cs_simps cat_Set_components(1)
               cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
           )
     qed
     show "\<D>\<^sub>\<circ> (E'\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>"
       unfolding E'_components by (simp add: cat_op_simps)
     show "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
     proof-
       from that[unfolded cat_op_simps] assms(3) show ?thesis
         by (intro cat_Set_\<alpha>\<beta>.subcat_is_arrD)
           (
             cs_concl 
               cs_simp:
                 category.cf_eval_ObjMap_app
                 category.cf_eval_ArrMap_app
                 E'_ObjMap_app
                 E'_ArrMap_app
               cs_intro: cat_cs_intros
           )
     qed
     then have [cat_cs_intros]: "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : A \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> B"
       if "A = E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>" and "B = E'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>" and "f : b \<mapsto>\<^bsub>\<AA>\<^esub> a" 
       for a b f A B
       using that by (simp add: cat_op_simps)
     show
       "E'\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> = E'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "g : b \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for b c g a f
     proof-
       note g = that(1)[unfolded cat_op_simps]
         and f = that(2)[unfolded cat_op_simps]
       from g f assms(3) \<alpha>\<beta> show ?thesis
         by 
           (
             cs_concl
               cs_intro:
                 cat_cs_intros
                 cat_prod_cs_intros
                 cat_FUNCT_cs_intros 
                 cat_op_intros
               cs_simp:
                 cat_cs_simps
                 cat_FUNCT_cs_simps 
                 cat_prod_cs_simps 
                 cat_op_simps
                 E.cf_ArrMap_Comp[symmetric]
           )+
     qed
     
     show "E'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
       if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
     proof(cs_concl_step cat_Set_\<alpha>\<beta>.subcat_CId[symmetric])
       from that[unfolded cat_op_simps] assms(3) show 
         "E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_Set \<alpha>\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps 
               cs_intro: cat_cs_intros
           )
       from that[unfolded cat_op_simps] assms(3) show 
         "E'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<alpha>\<lparr>CId\<rparr>\<lparr>E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
         by
           (
             cs_concl 
               cs_intro: cat_cs_intros
               cs_simp:
                 cat_Set_components(1)
                 cat_cs_simps
                 cat_op_simps
                 ntcf_id_cf_comp[symmetric]
           )
     qed
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
   then interpret E': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> E' by simp
 
 
   (** N' **)
 
   define N' :: V where "N' =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
       (\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>),
       op_cat \<AA>,
       cat_Set \<beta>
     ]\<^sub>\<circ> "
 
   have N'_components:
     "N'\<lparr>ObjMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
     "N'\<lparr>ArrMap\<rparr> =
       (\<lambda>f\<in>\<^sub>\<circ>\<AA>\<lparr>Arr\<rparr>. ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>)"
     "N'\<lparr>HomDom\<rparr> = op_cat \<AA>"
     "N'\<lparr>HomCod\<rparr> = cat_Set \<beta>"
     unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)
 
   note [cat_cs_simps] = N'_components(3,4)
   
   have N'_ObjMap_app[cat_cs_simps]: 
     "N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = ?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>"
     if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
     using that unfolding N'_components by simp
   have N'_ArrMap_app[cat_cs_simps]: 
     "N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = ?cf_nt\<lparr>ArrMap\<rparr>\<lparr>ntcf_arrow (?H_A\<GG> f), \<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>\<rparr>\<^sub>\<bullet>"
     if "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>" for f
     using that unfolding N'_components by simp
 
   from \<alpha>\<beta> interpret cf_nt_\<CC>: is_functor \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> \<open>?cf_nt\<close>
     by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
   
   have N': "N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
   proof(intro is_functorI')
     show "vfsequence N'" unfolding N'_def by simp
     show "vcard N' = 4\<^sub>\<nat>" unfolding N'_def by (simp add: nat_omega_simps)
     show "vsv (N'\<lparr>ObjMap\<rparr>)" unfolding N'_components by simp
     show "vsv (N'\<lparr>ArrMap\<rparr>)" unfolding N'_components by simp
     show "\<D>\<^sub>\<circ> (N'\<lparr>ObjMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
       unfolding N'_components by (simp add: cat_op_simps)
     show "\<R>\<^sub>\<circ> (N'\<lparr>ObjMap\<rparr>) \<subseteq>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
       unfolding N'_components
     proof(rule vrange_VLambda_vsubset)
       fix a assume prems: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       with assms(3) \<alpha>\<beta> show 
         "?cf_nt\<lparr>ObjMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet> \<in>\<^sub>\<circ> cat_Set \<beta>\<lparr>Obj\<rparr>"
         by 
           (
             cs_concl 
               cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps  
               cs_intro: cat_cs_intros FUNCT_\<CC>.cat_Hom_in_Vset cat_FUNCT_cs_intros
           )
     qed
     show "\<D>\<^sub>\<circ> (N'\<lparr>ArrMap\<rparr>) = op_cat \<AA>\<lparr>Arr\<rparr>" 
       unfolding N'_components by (simp add: cat_op_simps)
     show "N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ObjMap\<rparr>\<lparr>b\<rparr>"
       if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
       using that[unfolded cat_op_simps] assms(3)
       by 
         (
           cs_concl 
             cs_simp: N'_ObjMap_app N'_ArrMap_app 
             cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
         )
     show 
       "N'\<lparr>ArrMap\<rparr>\<lparr>g \<circ>\<^sub>A\<^bsub>op_cat \<AA>\<^esub> f\<rparr> = N'\<lparr>ArrMap\<rparr>\<lparr>g\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
       if "g : b \<mapsto>\<^bsub>op_cat \<AA>\<^esub> c" and "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for b c g a f
     proof-
       from that assms(3) \<alpha>\<beta> show ?thesis
         unfolding cat_op_simps
         by
           (
             cs_concl
               cs_intro:
                 cat_cs_intros
                 cat_prod_cs_intros
                 cat_FUNCT_cs_intros 
                 cat_op_intros
               cs_simp:
                 cat_cs_simps
                 cat_FUNCT_cs_simps 
                 cat_prod_cs_simps 
                 cat_op_simps
                 cf_nt_\<CC>.cf_ArrMap_Comp[symmetric]
           )
     qed
     show "N'\<lparr>ArrMap\<rparr>\<lparr>op_cat \<AA>\<lparr>CId\<rparr>\<lparr>a\<rparr>\<rparr> = cat_Set \<beta>\<lparr>CId\<rparr>\<lparr>N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>\<rparr>"
       if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
     proof-
       note [cat_cs_simps] = 
         ntcf_id_cf_comp[symmetric] 
         ntcf_arrow_id_ntcf_id[symmetric]
         cat_FUNCT_CId_app[symmetric] 
       from that[unfolded cat_op_simps] assms(3) \<alpha>\<beta> show ?thesis
         by (*very slow*)
           (
             cs_concl
               cs_intro:
                 cat_cs_intros
                 cat_FUNCT_cs_intros
                 cat_prod_cs_intros
                 cat_op_intros
               cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps 
           )+
     qed
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
   then interpret N': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> N' by simp
 
 
   (** Y' **)
   
   define Y' :: V where "Y' =
     [
       (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>),
       N',
       E',
       op_cat \<AA>,
       cat_Set \<beta>
     ]\<^sub>\<circ>"
 
   have Y'_components:
     "Y'\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>)"
     "Y'\<lparr>NTDom\<rparr> = N'"
     "Y'\<lparr>NTCod\<rparr> = E'"
     "Y'\<lparr>NTDGDom\<rparr> = op_cat \<AA>"
     "Y'\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
     unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)
 
   note [cat_cs_simps] = Y'_components(2-5)
 
   have Y'_NTMap_app[cat_cs_simps]: 
     "Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ntcf_Yoneda \<alpha> \<beta> \<CC>\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<AA>\<GG> a), c\<rparr>\<^sub>\<bullet>" 
     if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
     using that unfolding Y'_components by simp
 
   from \<beta> \<alpha>\<beta> interpret Y: 
     is_iso_ntcf \<beta> \<open>?FUNCT \<CC> \<times>\<^sub>C \<CC>\<close> \<open>cat_Set \<beta>\<close> ?cf_nt ?cf_eval \<open>ntcf_Yoneda \<alpha> \<beta> \<CC>\<close>
     by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)
 
   have Y': "Y' : N' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
   proof(intro is_iso_ntcfI is_ntcfI')
 
     show "vfsequence Y'" unfolding Y'_def by simp
     show "vcard Y' = 5\<^sub>\<nat>"
       unfolding Y'_def by (simp add: nat_omega_simps)
     show "vsv (Y'\<lparr>NTMap\<rparr>)" unfolding Y'_components by auto
     show "\<D>\<^sub>\<circ> (Y'\<lparr>NTMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>"
       unfolding Y'_components by (simp add: cat_op_simps)
     show Y'_NTMap_a: "Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
       using that[unfolded cat_op_simps] assms(3)
       by 
         (
           cs_concl 
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps
             cs_intro:
               cat_arrow_cs_intros
               cat_cs_intros
               cat_prod_cs_intros
               cat_FUNCT_cs_intros
         )
     then show "Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
       if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
       by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
     show
       "Y'\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
         E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> Y'\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
       if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
     proof-
       note f = that[unfolded cat_op_simps]
       from f assms(3) show ?thesis
         by 
           (
             cs_concl 
               cs_simp: cat_cs_simps Y.ntcf_Comp_commute 
               cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
           )+      
     qed
   qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
 
   have E'_def: "E' = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)"
   proof(rule cf_eqI)
     show "E' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
       by (cs_concl cs_intro: cat_cs_intros)
     from assms(3) show
       "Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
       by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
     have dom_lhs: "\<D>\<^sub>\<circ> (E'\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>" unfolding E'_components by simp
     from assms(3) have dom_rhs: 
       "\<D>\<^sub>\<circ> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>) = \<AA>\<lparr>Obj\<rparr>"
       unfolding E'_components 
       by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
     show "E'\<lparr>ObjMap\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
       fix a assume "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>"
       with assms(3) show "E'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         by
           (
             cs_concl
               cs_simp: cat_op_simps cat_cs_simps
               cs_intro: cat_cs_intros cat_op_intros
           )
     qed (auto simp: E'_components cat_cs_intros assms(3))
 
     have dom_lhs: "\<D>\<^sub>\<circ> (E'\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>" unfolding E'_components by simp
     from assms(3) have dom_rhs: 
       "\<D>\<^sub>\<circ> (Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>) = \<AA>\<lparr>Arr\<rparr>"
       unfolding E'_components 
       by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
     
     show "E'\<lparr>ArrMap\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>"
     proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
 
       fix f assume prems: "f \<in>\<^sub>\<circ> \<AA>\<lparr>Arr\<rparr>"
       then obtain a b where f: "f : a \<mapsto>\<^bsub>\<AA>\<^esub> b" by auto
       have [cat_cs_simps]:
         "cf_eval_arrow \<CC> (ntcf_arrow (?H_A\<GG> f)) (\<CC>\<lparr>CId\<rparr>\<lparr>c\<rparr>) =
           cf_hom \<AA> [f, \<AA>\<lparr>CId\<rparr>\<lparr>?\<GG>c\<rparr>]\<^sub>\<circ>"
         (is \<open>?cf_eval_arrow = ?cf_hom_f\<GG>c\<close>)
       proof-
         have cf_eval_arrow_f_CId_\<GG>c:
           "?cf_eval_arrow :
             Hom \<AA> b ?\<GG>c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a ?\<GG>c"
         proof(rule cf_eval_arrow_is_arr')
           from f show "?H_A\<GG> f :
             ?H_\<AA>\<GG> b \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<GG> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
             by (cs_concl cs_intro: cat_cs_intros)
         qed
           (
             use f assms(3) in
               \<open>
                 cs_concl
                   cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
               \<close>
           )+
         from f assms(3) have dom_lhs:
           "\<D>\<^sub>\<circ> (?cf_eval_arrow\<lparr>ArrVal\<rparr>) = Hom \<AA> b ?\<GG>c"
           by
             (
               cs_concl
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
             )
         from assms(3) f Ran.HomCod.category_axioms have cf_hom_f\<GG>c:
           "?cf_hom_f\<GG>c :
             Hom \<AA> b ?\<GG>c \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> a ?\<GG>c"
           by 
             (
               cs_concl cs_intro:
                 cat_cs_intros cat_prod_cs_intros cat_op_intros
             )
         from f assms(3) have dom_rhs: 
           "\<D>\<^sub>\<circ> (?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>) = Hom \<AA> b ?\<GG>c"
           by
             (
               cs_concl 
                 cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
             )
 
         show ?thesis
         proof(rule arr_Set_eqI)
           from cf_eval_arrow_f_CId_\<GG>c show "arr_Set \<alpha> ?cf_eval_arrow"
             by (auto dest: cat_Set_is_arrD(1))
           from cf_hom_f\<GG>c show "arr_Set \<alpha> ?cf_hom_f\<GG>c"
             by (auto dest: cat_Set_is_arrD(1))
           show "?cf_eval_arrow\<lparr>ArrVal\<rparr> = ?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>"
           proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
             from f assms(3) show "vsv (?cf_eval_arrow\<lparr>ArrVal\<rparr>)"
               by (cs_concl cs_intro: cat_cs_intros)
             from f assms(3) show "vsv (?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>)"
               by
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_op_simps 
                     cs_intro: cat_cs_intros cat_op_intros
                 )            
             fix g assume "g : b \<mapsto>\<^bsub>\<AA>\<^esub> ?\<GG>c"
             with f assms(3) show 
               "?cf_eval_arrow\<lparr>ArrVal\<rparr>\<lparr>g\<rparr> = ?cf_hom_f\<GG>c\<lparr>ArrVal\<rparr>\<lparr>g\<rparr>"
               by
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_op_simps
                     cs_intro: cat_cs_intros cat_op_intros
                 )
           qed simp
 
         qed
           (
             use cf_eval_arrow_f_CId_\<GG>c cf_hom_f\<GG>c in 
               \<open>cs_concl cs_simp: cat_cs_simps\<close>
           )+
 
       qed
       
       from f prems assms(3) show
         "E'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
         by
           (
             cs_concl
               cs_simp: cat_op_simps cat_cs_simps 
               cs_intro: cat_cs_intros cat_op_intros
           )
 
     qed (auto simp: E'_components cat_cs_intros assms(3))
 
   qed simp_all
 
   from Y' have inv_Y': "inv_ntcf Y' :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)
 
   interpret N'': is_functor \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> \<open>L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<close>
     by (rule L_10_5_N_is_functor[OF \<beta> \<alpha>\<beta> assms])
 
 
   (** \<psi> **)
 
   define \<psi> :: V
     where "\<psi> =
       [
         (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>),
         N',
         L_10_5_N \<alpha> \<beta> \<TT> \<KK> c,
         op_cat \<AA>,
         cat_Set \<beta>
       ]\<^sub>\<circ>"
 
   have \<psi>_components:
     "\<psi>\<lparr>NTMap\<rparr> = (\<lambda>a\<in>\<^sub>\<circ>\<AA>\<lparr>Obj\<rparr>. ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>)"
     "\<psi>\<lparr>NTDom\<rparr> = N'"
     "\<psi>\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c"
     "\<psi>\<lparr>NTDGDom\<rparr> = op_cat \<AA>"
     "\<psi>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>"
     unfolding \<psi>_def nt_field_simps by (simp_all add: nat_omega_simps)
 
   note [cat_cs_simps] = Y'_components(2-5)
 
   have \<psi>_NTMap_app[cat_cs_simps]: 
     "\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> = ?ntcf_ua_fo a\<lparr>NTMap\<rparr>\<lparr>cf_map (?H_\<CC> c)\<rparr>" 
     if "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" for a
     using that unfolding \<psi>_components by simp
 
   have \<psi>: "\<psi> : N' \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
   proof-
 
     show ?thesis
     proof(intro is_iso_ntcfI is_ntcfI')
 
       show "vfsequence \<psi>" unfolding \<psi>_def by auto
       show "vcard \<psi> = 5\<^sub>\<nat>" unfolding \<psi>_def by (simp_all add: nat_omega_simps)
       show "N' : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>" by (rule N')
       show "L_10_5_N \<alpha> \<beta> \<TT> \<KK> c : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
         by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
       show "\<psi>\<lparr>NTDom\<rparr> = N'" unfolding \<psi>_components by simp
       show "\<psi>\<lparr>NTCod\<rparr> = L_10_5_N \<alpha> \<beta> \<TT> \<KK> c" unfolding \<psi>_components by simp
       show "\<psi>\<lparr>NTDGDom\<rparr> = op_cat \<AA>" unfolding \<psi>_components by simp
       show "\<psi>\<lparr>NTDGCod\<rparr> = cat_Set \<beta>" unfolding \<psi>_components by simp
       show "vsv (\<psi>\<lparr>NTMap\<rparr>)" unfolding \<psi>_components by simp
       show "\<D>\<^sub>\<circ> (\<psi>\<lparr>NTMap\<rparr>) = op_cat \<AA>\<lparr>Obj\<rparr>" 
         unfolding \<psi>_components by (simp add: cat_op_simps)
 
       show \<psi>_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
         "\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^sub>i\<^sub>s\<^sub>o\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
       proof-
         note a = that[unfolded cat_op_simps]
         interpret \<epsilon>: 
           is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> a\<close> \<epsilon>
           by (rule cat_pw_rKe_preserved[OF a])
         interpret a\<epsilon>: 
           is_cat_rKe \<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> a\<close> \<open>?H_\<AA>\<GG> a\<close> \<open>?H_\<AA>\<epsilon> a\<close>
           by (rule \<epsilon>.cat_rKe_preserves)
         interpret is_iso_ntcf
           \<beta>
           \<open>op_cat (?FUNCT \<CC>)\<close>
           \<open>cat_Set \<beta>\<close>
           \<open>?H_FUNCT \<CC> (?H_\<AA>\<GG> a)\<close>
           \<open>?H_FUNCT \<BB> (?H_\<AA>\<TT> a) \<circ>\<^sub>C\<^sub>F op_cf ?SET_\<KK>\<close>
           \<open>?ntcf_ua_fo a\<close>
           by (rule a\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])
         have "cf_map (?H_\<CC> c) \<in>\<^sub>\<circ> ?FUNCT \<CC>\<lparr>Obj\<rparr>"
           by
             (
               cs_concl 
                 cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
                 cs_intro: cat_cs_intros cat_FUNCT_cs_intros
             )
         from 
           iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this] 
           a assms \<alpha>\<beta> 
         show ?thesis
           by (*very slow*)
             (
               cs_prems 
                 cs_simp: 
                   cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps 
                 cs_intro: 
                   cat_small_cs_intros 
                   cat_Kan_cs_intros
                   cat_cs_intros
                   cat_FUNCT_cs_intros
                   cat_op_intros
             )
       qed
       show \<psi>_NTMap_is_arr[unfolded cat_op_simps]: 
         "\<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr> : N'\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
         if "a \<in>\<^sub>\<circ> op_cat \<AA>\<lparr>Obj\<rparr>" for a
         by 
           (
             rule cat_Set_is_arr_isomorphismD[
               OF \<psi>_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
               ]
           )
 
       show 
         "\<psi>\<lparr>NTMap\<rparr>\<lparr>b\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> N'\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> =
           L_10_5_N \<alpha> \<beta> \<TT> \<KK> c\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> \<psi>\<lparr>NTMap\<rparr>\<lparr>a\<rparr>"
         if "f : a \<mapsto>\<^bsub>op_cat \<AA>\<^esub> b" for a b f
       proof-
 
         note f = that[unfolded cat_op_simps]
         from f have a: "a \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" and b: "b \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" by auto
 
         interpret p_a_\<epsilon>: 
           is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> a\<close> \<epsilon>
           by (rule cat_pw_rKe_preserved[OF a])
         interpret a_\<epsilon>: is_cat_rKe 
           \<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> a\<close> \<open>?H_\<AA>\<GG> a\<close> \<open>?H_\<AA>\<epsilon> a\<close>
           by (rule p_a_\<epsilon>.cat_rKe_preserves)
         interpret ntcf_ua_fo_a_\<epsilon>: is_iso_ntcf
           \<beta> ?ua_NTDGDom \<open>cat_Set \<beta>\<close> \<open>?ua_NTDom a\<close> \<open>?ua_NTCod a\<close> \<open>?ua a\<close>
           by (rule a_\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])
 
         interpret p_b_\<epsilon>:
           is_cat_rKe_preserves \<alpha> \<BB> \<CC> \<AA> \<open>cat_Set \<alpha>\<close> \<KK> \<TT> \<GG> \<open>?H_\<AA> b\<close> \<epsilon>
           by (rule cat_pw_rKe_preserved[OF b])
         interpret b_\<epsilon>: is_cat_rKe 
           \<alpha> \<BB> \<CC> \<open>cat_Set \<alpha>\<close> \<KK> \<open>?H_\<AA>\<TT> b\<close> \<open>?H_\<AA>\<GG> b\<close> \<open>?H_\<AA>\<epsilon> b\<close>
           by (rule p_b_\<epsilon>.cat_rKe_preserves)
         interpret ntcf_ua_fo_b_\<epsilon>: is_iso_ntcf
           \<beta> ?ua_NTDGDom \<open>cat_Set \<beta>\<close> \<open>?ua_NTDom b\<close> \<open>?ua_NTCod b\<close> \<open>?ua b\<close>
           by (rule b_\<epsilon>.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF \<beta> \<alpha>\<beta>])
 
         interpret \<KK>_SET: is_tiny_functor \<beta> \<open>?FUNCT \<CC>\<close> \<open>?FUNCT \<BB>\<close> ?SET_\<KK>
           by 
             (
               rule exp_cat_cf_is_tiny_functor[
                 OF \<beta> \<alpha>\<beta> AG.category_cat_Set AG.is_functor_axioms
                 ]
             )
         from f interpret Hom_f:
           is_ntcf \<alpha> \<AA> \<open>cat_Set \<alpha>\<close> \<open>?H_\<AA> a\<close> \<open>?H_\<AA> b\<close> \<open>?H_A f\<close>
           by (cs_concl cs_intro: cat_cs_intros)
 
         let ?cf_hom_lhs =
           \<open>
             cf_hom
               (?FUNCT \<CC>)
               [ntcf_arrow (ntcf_id (?H_\<CC> c)), ntcf_arrow (?H_A\<GG> f)]\<^sub>\<circ>
           \<close>
         let ?cf_hom_rhs = 
           \<open>
             cf_hom
               (?FUNCT \<BB>)
               [
                 ntcf_arrow (ntcf_id (?H_\<CC> c \<circ>\<^sub>C\<^sub>F \<KK>)),
                 ntcf_arrow (?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT>)
               ]\<^sub>\<circ>
           \<close>
         let ?dom =
           \<open>Hom (?FUNCT \<CC>) (cf_map (?H_\<CC> c)) (cf_map (?H_\<AA>\<GG> a))\<close>
         let ?cod = \<open>Hom (?FUNCT \<BB>) (cf_map (?H_\<CC>\<KK> c)) (cf_map (?H_\<AA>\<TT> b))\<close>
         let ?cf_hom_lhs_umap_fo_inter =
           \<open>Hom (?FUNCT \<CC>) (cf_map (?H_\<CC> c)) (cf_map (?H_\<AA>\<GG> b))\<close>
         let ?umap_fo_cf_hom_rhs_inter =
           \<open>Hom (?FUNCT \<BB>) (cf_map (?H_\<CC>\<KK> c)) (cf_map (?H_\<AA>\<TT> a))\<close>
 
         have [cat_cs_simps]:
           "?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs =
             ?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a"
         proof-
 
           from f assms(3) \<alpha>\<beta> have cf_hom_lhs:
             "?cf_hom_lhs : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs_umap_fo_inter"
             by
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                   cs_intro:
                     cat_cs_intros
                     cat_FUNCT_cs_intros
                     cat_prod_cs_intros
                     cat_op_intros
               )
           from f assms(3) \<alpha>\<beta> have umap_fo_b:
             "?umap_fo b : ?cf_hom_lhs_umap_fo_inter \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
             by
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                   cs_intro: 
                     cat_cs_intros
                     cat_FUNCT_cs_intros
                     cat_prod_cs_intros
                     cat_op_intros
               )
           from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
             "?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           then have dom_umap_fo_cf_hom_lhs: 
             "\<D>\<^sub>\<circ> ((?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>) = ?dom"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
           from f assms(3) \<alpha>\<beta> have cf_hom_rhs: 
             "?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
             by (*slow*)
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                   cs_intro:
                     cat_cs_intros
                     cat_FUNCT_cs_intros
                     cat_prod_cs_intros
                     cat_op_intros
               )
           from f assms(3) \<alpha>\<beta> have umap_fo_a:
             "?umap_fo a : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo_cf_hom_rhs_inter"
             by (*slow*)
               (
                 cs_concl
                   cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                   cs_intro:
                     cat_cs_intros 
                     cat_FUNCT_cs_intros 
                     cat_prod_cs_intros 
                     cat_op_intros
               )
           from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a: 
             "?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a : ?dom \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> ?cod"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
           then have dom_cf_hom_rhs_umap_fo_a: 
             "\<D>\<^sub>\<circ> ((?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>) = ?dom"
             by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
           
           show ?thesis
           proof(rule arr_Set_eqI)
 
             from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs: 
               "arr_Set \<beta> (?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)"
               by (auto dest: cat_Set_is_arrD(1))
             from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a: 
               "arr_Set \<beta> (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)"
               by (auto dest: cat_Set_is_arrD(1))
 
             show 
               "(?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr> =
                 (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>"
             proof
               (
                 rule vsv_eqI, 
                 unfold 
                   dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff; 
                 (rule refl)?
               )
 
               fix \<HH> assume prems:
                 "\<HH> : cf_map (?H_\<CC> c) \<mapsto>\<^bsub>?FUNCT \<CC>\<^esub> cf_map (?H_\<AA>\<GG> a)"
 
               let ?\<HH> = \<open>ntcf_of_ntcf_arrow \<CC> (cat_Set \<alpha>) \<HH>\<close>
               let ?lhs = \<open>?H_\<AA>\<epsilon> b \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ((?H_A\<GG> f \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?\<HH>) \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>)\<close>
               let ?rhs = 
                 \<open>(?H_A f \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<TT> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ?H_\<AA>\<epsilon> a \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F (?\<HH> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F \<KK>))\<close>
               let ?cf_hom_\<AA>\<epsilon> = \<open>\<lambda>b b'. cf_hom \<AA> [\<AA>\<lparr>CId\<rparr>\<lparr>b\<rparr>, \<epsilon>\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>]\<^sub>\<circ>\<close>
               let ?Yc = \<open>\<lambda>Q. Yoneda_component (?H_\<AA> b) a f Q\<close>
               let ?\<HH>\<KK> = \<open>\<lambda>b'. ?\<HH>\<lparr>NTMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
               let ?\<GG>\<KK> = \<open>\<lambda>b'. \<GG>\<lparr>ObjMap\<rparr>\<lparr>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<rparr>\<close>
 
               have [cat_cs_simps]: 
                 "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map (?H_\<CC> c)) = ?H_\<CC> c"
                 by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
               have [cat_cs_simps]: 
                 "cf_of_cf_map \<CC> (cat_Set \<alpha>) (cf_map (?H_\<AA>\<GG> a)) = ?H_\<AA>\<GG> a"
                 by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
               note \<HH> = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
               have Hom_c: "?H_\<CC>\<KK> c : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
                 by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
 
               have [cat_cs_simps]: "?lhs = ?rhs"
               proof(rule ntcf_eqI)
                 from \<HH>(1) f show lhs: 
                   "?lhs : ?H_\<CC>\<KK> c \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<TT> b : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
                   by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                 then have dom_lhs: "\<D>\<^sub>\<circ> (?lhs\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>" 
                   by (cs_concl cs_simp: cat_cs_simps)+
                 from \<HH>(1) f show rhs: 
                   "?rhs : ?H_\<CC>\<KK> c \<mapsto>\<^sub>C\<^sub>F ?H_\<AA>\<TT> b : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_Set \<alpha>"
                   by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                 then have dom_rhs: "\<D>\<^sub>\<circ> (?rhs\<lparr>NTMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
                   by (cs_concl cs_simp: cat_cs_simps)+
                 have [cat_cs_simps]:
                   "?cf_hom_\<AA>\<epsilon> b b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> 
                     (?Yc (?\<GG>\<KK> b') \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<HH>\<KK> b') =
                       ?Yc (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>) \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub>
                         (?cf_hom_\<AA>\<epsilon> a b' \<circ>\<^sub>A\<^bsub>cat_Set \<alpha>\<^esub> ?\<HH>\<KK> b')"
                   (is \<open>?lhs_Set = ?rhs_Set\<close>)
                   if "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>" for b'
                 proof-
                   let ?\<KK>b' = \<open>\<KK>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>\<close>
                   from \<HH>(1) f that assms(3) Ran.HomCod.category_axioms 
                   have lhs_Set_is_arr: "?lhs_Set :
                     Hom \<CC> c (?\<KK>b') \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
                     by
                       (
                         cs_concl
                           cs_simp: cat_cs_simps cat_op_simps 
                           cs_intro: 
                             cat_cs_intros cat_prod_cs_intros cat_op_intros
                       )
                   then have dom_lhs_Set: "\<D>\<^sub>\<circ> (?lhs_Set\<lparr>ArrVal\<rparr>) = Hom \<CC> c ?\<KK>b'" 
                     by (cs_concl cs_simp: cat_cs_simps)
                   from \<HH>(1) f that assms(3) Ran.HomCod.category_axioms 
                   have rhs_Set_is_arr: "?rhs_Set :
                     Hom \<CC> c (?\<KK>b') \<mapsto>\<^bsub>cat_Set \<alpha>\<^esub> Hom \<AA> b (\<TT>\<lparr>ObjMap\<rparr>\<lparr>b'\<rparr>)"
                     by
                       (
                         cs_concl
                           cs_simp: cat_cs_simps cat_op_simps 
                           cs_intro:
                             cat_cs_intros cat_prod_cs_intros cat_op_intros
                       )
                   then have dom_rhs_Set: "\<D>\<^sub>\<circ> (?rhs_Set\<lparr>ArrVal\<rparr>) = Hom \<CC> c ?\<KK>b'" 
                     by (cs_concl cs_simp: cat_cs_simps)
                   show ?thesis
                   proof(rule arr_Set_eqI)
                     from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set \<alpha> ?lhs_Set" 
                       by (auto dest: cat_Set_is_arrD(1))
                     from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set \<alpha> ?rhs_Set"
                       by (auto dest: cat_Set_is_arrD(1))
                     show "?lhs_Set\<lparr>ArrVal\<rparr> = ?rhs_Set\<lparr>ArrVal\<rparr>"
                     proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
                       fix h assume "h : c \<mapsto>\<^bsub>\<CC>\<^esub> ?\<KK>b'"
                       with \<HH>(1) f that assms Ran.HomCod.category_axioms show 
                         "?lhs_Set\<lparr>ArrVal\<rparr>\<lparr>h\<rparr> = ?rhs_Set\<lparr>ArrVal\<rparr>\<lparr>h\<rparr>"
                         by (*exceptionally slow*) 
                           (
                             cs_concl 
                               cs_simp: cat_cs_simps cat_op_simps 
                               cs_intro: 
                                 cat_cs_intros cat_prod_cs_intros cat_op_intros
                           )
                     qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
                   qed
                     (
                       use lhs_Set_is_arr rhs_Set_is_arr in
                         \<open>cs_concl cs_simp: cat_cs_simps\<close>
                     )+
 
               qed
 
               show "?lhs\<lparr>NTMap\<rparr> = ?rhs\<lparr>NTMap\<rparr>"
               proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
                 fix b' assume "b' \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
                 with \<HH>(1) f assms(3) show "?lhs\<lparr>NTMap\<rparr>\<lparr>b'\<rparr> = ?rhs\<lparr>NTMap\<rparr>\<lparr>b'\<rparr>"
                   by (*slow*)
                     (
                       cs_concl
                         cs_simp: cat_cs_simps cat_op_simps 
                         cs_intro: cat_cs_intros
                     )
               qed (cs_concl cs_intro: cat_cs_intros)
 
             qed simp_all
 
             from 
               assms(3) f \<HH>(1) prems \<alpha>\<beta> 
               (*speedup*)
               Ran.HomCod.category_axioms 
               FUNCT_\<CC>.category_axioms
               FUNCT_\<BB>.category_axioms
               AG.is_functor_axioms
               Ran.is_functor_axioms
               Hom_f.is_ntcf_axioms
             show
               "(?umap_fo b \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?cf_hom_lhs)\<lparr>ArrVal\<rparr>\<lparr>\<HH>\<rparr> =
                 (?cf_hom_rhs \<circ>\<^sub>A\<^bsub>cat_Set \<beta>\<^esub> ?umap_fo a)\<lparr>ArrVal\<rparr>\<lparr>\<HH>\<rparr>"
                 by (subst (1 2) \<HH>(2)) (*exceptionally slow*)
                 (
                   cs_concl
                     cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
                     cs_intro:
                       cat_cs_intros 
                       cat_prod_cs_intros 
                       cat_FUNCT_cs_intros
                       cat_op_intros
                 )
 
             qed
               (
                 use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
                   auto
               )
 
           qed
             (
               use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
                 \<open>cs_concl cs_simp: cat_cs_simps\<close>
             )+
 
         qed
 
         from f assms \<alpha>\<beta> show ?thesis
           by (*slow*)
             (
               cs_concl
                 cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
                 cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
             )
 
       qed
 
     qed auto
 
   qed
 
 
   (**main**)
 
   from L_10_5_\<chi>_is_iso_ntcf[OF \<beta> \<alpha>\<beta> assms] have inv_\<chi>:
     "inv_ntcf (L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c) :
       L_10_5_N \<alpha> \<beta> \<TT> \<KK> c \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK> :
       op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     by (auto intro: iso_ntcf_is_arr_isomorphism)
  
   define \<phi> where "\<phi> = inv_ntcf (L_10_5_\<chi> \<alpha> \<beta> \<TT> \<KK> c) \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<psi> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F inv_ntcf Y'"
   
   from inv_Y' \<psi> inv_\<chi> have \<phi>: "\<phi> :
     Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c) \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>i\<^sub>s\<^sub>o cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK> :
     op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> cat_Set \<beta>"
     unfolding \<phi>_def by (cs_concl cs_intro: cat_cs_intros)
 
   interpret \<phi>: is_iso_ntcf
     \<beta> \<open>op_cat \<AA>\<close> \<open>cat_Set \<beta>\<close> \<open>Hom\<^sub>O\<^sub>.\<^sub>C\<^bsub>\<beta>\<^esub>\<AA>(-,?\<GG>c)\<close> \<open>cf_Cone \<alpha> \<beta> ?\<TT>_c\<KK>\<close> \<phi>
     by (rule \<phi>)
 
   let ?\<phi>_\<GG>c_CId = \<open>\<phi>\<lparr>NTMap\<rparr>\<lparr>?\<GG>c\<rparr>\<lparr>ArrVal\<rparr>\<lparr>\<AA>\<lparr>CId\<rparr>\<lparr>?\<GG>c\<rparr>\<rparr>\<close>
   let ?ntcf_\<phi>_\<GG>c_CId = \<open>ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> ?\<phi>_\<GG>c_CId\<close>
 
   from AG.vempty_is_zet assms(3) have \<Delta>: "?\<Delta> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<beta>\<^esub> ?c\<KK>_\<AA>"
     by
       (
         cs_concl
           cs_simp: cat_comma_cs_simps 
           cs_intro: cat_cs_intros cat_comma_cs_intros
       )
   from assms(3) have \<GG>c: "?\<GG>c \<in>\<^sub>\<circ> \<AA>\<lparr>Obj\<rparr>" 
     by (cs_concl cs_intro: cat_cs_intros)
   from AG.vempty_is_zet have \<TT>_c\<KK>: "cf_map (?\<TT>_c\<KK>) \<in>\<^sub>\<circ> ?c\<KK>_\<AA>\<lparr>Obj\<rparr>"
     by
       (
         cs_concl
           cs_simp: cat_FUNCT_components(1) 
           cs_intro: cat_cs_intros cat_FUNCT_cs_intros
       )
 
   from
     \<phi>.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF \<GG>c]
     assms(3)
     AG.vempty_is_zet
     \<beta>.vempty_is_zet
     \<alpha>\<beta>
   have \<phi>_\<GG>c: "\<phi>\<lparr>NTMap\<rparr>\<lparr>?\<GG>c\<rparr> :
     Hom \<AA> ?\<GG>c?\<GG>c \<mapsto>\<^bsub>cat_Set \<beta>\<^esub> 
     Hom ?c\<KK>_\<AA> (cf_map (?cf_c\<KK>_\<AA> ?\<GG>c)) (cf_map ?\<TT>_c\<KK>)"
     by (*very slow*)
       (
         cs_prems
           cs_simp:
             cat_cs_simps
             cat_Kan_cs_simps
             cat_comma_cs_simps 
             cat_op_simps 
             cat_FUNCT_components(1) 
           cs_intro: 
             cat_Kan_cs_intros
             cat_comma_cs_intros 
             cat_cs_intros 
             cat_FUNCT_cs_intros 
             cat_op_intros 
       )
 
   with assms(3) have \<phi>_\<GG>c_CId: 
     "?\<phi>_\<GG>c_CId : cf_map (?cf_c\<KK>_\<AA> ?\<GG>c) \<mapsto>\<^bsub>?c\<KK>_\<AA>\<^esub> cf_map ?\<TT>_c\<KK>"
     by (cs_concl cs_intro: cat_cs_intros)
   have ntcf_arrow_\<phi>_\<GG>c_CId: "ntcf_arrow ?ntcf_\<phi>_\<GG>c_CId = ?\<phi>_\<GG>c_CId"
     by (rule cat_FUNCT_is_arrD(2)[OF \<phi>_\<GG>c_CId, symmetric])
 
   have ua: "universal_arrow_fo ?\<Delta> (cf_map (?\<TT>_c\<KK>)) ?\<GG>c ?\<phi>_\<GG>c_CId"
     by 
       (
         rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf[
           OF \<Delta> \<GG>c \<TT>_c\<KK> \<phi>[unfolded cf_Cone_def cat_cs_simps]
           ]
       )
   moreover have ntcf_\<phi>_\<GG>c_CId: 
     "?ntcf_\<phi>_\<GG>c_CId : ?\<GG>c <\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>n\<^sub>e ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   proof(intro is_cat_coneI)
     from cat_FUNCT_is_arrD(1)[OF \<phi>_\<GG>c_CId] assms(3) AG.vempty_is_zet show 
       "ntcf_of_ntcf_arrow (c \<down>\<^sub>C\<^sub>F \<KK>) \<AA> ?\<phi>_\<GG>c_CId :
         ?cf_c\<KK>_\<AA> ?\<GG>c \<mapsto>\<^sub>C\<^sub>F ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
       by
         (
           cs_prems
             cs_simp: cat_cs_simps cat_FUNCT_cs_simps
             cs_intro: cat_cs_intros cat_FUNCT_cs_intros
         )
   qed (rule \<GG>c)
   ultimately have "?ntcf_\<phi>_\<GG>c_CId : ?\<GG>c <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m ?\<TT>_c\<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     by (intro is_cat_cone.cat_cone_is_cat_limit) 
       (simp_all add: ntcf_arrow_\<phi>_\<GG>c_CId)
   then show ?thesis using that by auto
 
 qed
 
-
-
-subsection\<open>The limit for the pointwise Kan extension\<close>
+lemma (in is_cat_pw_lKe) cat_pw_lKe_ex_cat_colimit:
+  \<comment>\<open>Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
+    and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+  obtains UA 
+    where "UA : \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+proof-
+  from 
+    is_cat_pw_rKe.cat_pw_rKe_ex_cat_limit
+      [
+        OF is_cat_pw_rKe_op AG.is_functor_op ntcf_lKe.NTDom.is_functor_op,
+        unfolded cat_op_simps, 
+        OF assms(3)
+      ]
+  obtain UA where UA: "UA :
+    \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) : 
+    c \<down>\<^sub>C\<^sub>F (op_cf \<KK>) \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> op_cat \<AA>"
+    by auto
+  from assms(3) have [cat_cs_simps]:
+    "op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<KK> c = 
+      op_cf \<TT> \<circ>\<^sub>C\<^sub>F op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)"
+    by
+      (
+        cs_concl
+          cs_simp: cat_cs_simps AG.op_cf_cf_obj_comma_proj[OF assms(3)] 
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  from assms(3) have [cat_op_simps]:
+    "\<TT> \<circ>\<^sub>C\<^sub>F op_cf (c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>)) \<circ>\<^sub>C\<^sub>F op_cf (op_cf_obj_comma \<KK> c) = 
+      \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c"
+    by
+      (
+        cs_concl
+          cs_simp:
+            cat_cs_simps cat_op_simps 
+            op_cf_cf_comp[symmetric] AG.op_cf_cf_obj_comma_proj[symmetric] 
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  from assms(3) have [cat_op_simps]: "op_cat (op_cat (\<KK> \<^sub>C\<^sub>F\<down> c)) = \<KK> \<^sub>C\<^sub>F\<down> c"
+    by
+      (
+        cs_concl 
+          cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros 
+      )
+  note ntcf_cf_comp_is_cat_limit_if_is_iso_functor =
+    ntcf_cf_comp_is_cat_limit_if_is_iso_functor
+      [
+        OF UA AG.op_cf_obj_comma_is_iso_functor[OF assms(3)], 
+        unfolded cat_op_simps
+      ]
+  have "op_ntcf UA \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F op_cf (op_cf_obj_comma \<KK> c) : 
+    \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> : \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+    by 
+      (
+        rule is_cat_limit.is_cat_colimit_op
+          [
+            OF ntcf_cf_comp_is_cat_limit_if_is_iso_functor, 
+            unfolded cat_op_simps
+          ]
+      )
+  then show ?thesis using that by auto
+qed
+
+
+
+subsection\<open>The limit and the colimit for the pointwise Kan extensions\<close>
 
 
 subsubsection\<open>Definition and elementary properties\<close>
 
 
 text\<open>See Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.\<close>
 
 definition the_pw_cat_rKe_limit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
   where "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c =
     [
       \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>,
       (
         SOME UA.
           UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<TT>\<lparr>HomCod\<rparr>
       )
     ]\<^sub>\<circ>"
 
+definition the_pw_cat_lKe_colimit :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
+  where "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c =
+    [
+      \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>,
+      op_ntcf
+        (
+          the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
+          op_cf_obj_comma \<KK> c
+        )
+    ]\<^sub>\<circ>"
+
 
 text\<open>Components.\<close>
 
 lemma the_pw_cat_rKe_limit_components:
   shows "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UObj\<rparr> = \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
     and "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UArr\<rparr> = 
       (
         SOME UA.
           UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<TT>\<lparr>HomCod\<rparr>
       )"
   unfolding the_pw_cat_rKe_limit_def ua_field_simps
   by (simp_all add: nat_omega_simps)
 
+lemma the_pw_cat_lKe_colimit_components:
+  shows "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr> = \<FF>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr>"
+    and "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UArr\<rparr> = op_ntcf
+      (
+        the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UArr\<rparr> \<circ>\<^sub>N\<^sub>T\<^sub>C\<^sub>F\<^sub>-\<^sub>C\<^sub>F
+        op_cf_obj_comma \<KK> c
+      )"
+  unfolding the_pw_cat_lKe_colimit_def ua_field_simps
+  by (simp_all add: nat_omega_simps)
+
 context is_functor
 begin
 
 lemmas the_pw_cat_rKe_limit_components' = 
   the_pw_cat_rKe_limit_components[where \<TT>=\<FF>, unfolded cat_cs_simps]
 
 end
 
 
-subsubsection\<open>The limit for the pointwise Kan extension is a limit\<close>
-
-lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_limit:
+subsubsection\<open>
+The limit for the pointwise right Kan extension is a limit,
+the colimit for the pointwise left Kan extension is a colimit
+\<close>
+
+lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit:
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
   shows "the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UArr\<rparr> :
     the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG> c\<lparr>UObj\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> :
     c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
 proof-
   from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA 
     where UA: "UA : \<GG>\<lparr>ObjMap\<rparr>\<lparr>c\<rparr> <\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>i\<^sub>m \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F \<KK> : c \<down>\<^sub>C\<^sub>F \<KK> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
     by auto
   show ?thesis
     unfolding the_pw_cat_rKe_limit_components
     by (rule someI2, unfold cat_cs_simps, rule UA)
 qed
 
+lemma (in is_cat_pw_lKe) cat_pw_lKe_the_pw_cat_lKe_colimit_is_cat_colimit:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>" and "c \<in>\<^sub>\<circ> \<CC>\<lparr>Obj\<rparr>"
+  shows "the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UArr\<rparr> : 
+    \<TT> \<circ>\<^sub>C\<^sub>F \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c >\<^sub>C\<^sub>F\<^sub>.\<^sub>c\<^sub>o\<^sub>l\<^sub>i\<^sub>m the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr> :
+    \<KK> \<^sub>C\<^sub>F\<down> c \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+proof-
+  interpret \<KK>: is_functor \<alpha> \<BB> \<CC> \<KK> by (rule assms(1))
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  note cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit = 
+    is_cat_pw_rKe.cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit
+      [
+        OF is_cat_pw_rKe_op AG.is_functor_op ntcf_lKe.NTDom.is_functor_op, 
+        unfolded cat_op_simps,
+        OF assms(3)
+      ]
+  from assms(3) have
+    "op_cf \<TT> \<circ>\<^sub>C\<^sub>F c \<^sub>O\<Sqinter>\<^sub>C\<^sub>F (op_cf \<KK>) \<circ>\<^sub>C\<^sub>F op_cf_obj_comma \<KK> c = 
+      op_cf \<TT> \<circ>\<^sub>C\<^sub>F op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)"
+    by
+      (
+        cs_concl
+          cs_simp:
+            cat_cs_simps cat_comma_cs_simps cat_op_simps
+            AG.op_cf_cf_obj_comma_proj[OF assms(3)] 
+          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
+      )
+  note ntcf_cf_comp_is_cat_limit_if_is_iso_functor = 
+    ntcf_cf_comp_is_cat_limit_if_is_iso_functor
+      [
+        OF 
+          cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit 
+          AG.op_cf_obj_comma_is_iso_functor[OF assms(3)],
+          unfolded this, folded op_cf_cf_comp
+      ]
+  from assms(3) have [cat_op_simps]: "op_cat (op_cat (\<KK> \<^sub>C\<^sub>F\<down> c)) = \<KK> \<^sub>C\<^sub>F\<down> c"
+    by 
+      (
+        cs_concl 
+          cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  from assms(3) have [cat_op_simps]: "op_cf (op_cf (\<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c)) = \<KK> \<^sub>C\<^sub>F\<Sqinter>\<^sub>O c"
+    by 
+      (
+        cs_concl 
+          cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_comma_cs_intros
+      )
+  have [cat_op_simps]:
+    "the_pw_cat_rKe_limit \<alpha> (op_cf \<KK>) (op_cf \<TT>) (op_cf \<FF>) c\<lparr>UObj\<rparr> = 
+      the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF> c\<lparr>UObj\<rparr>"
+    unfolding 
+      the_pw_cat_lKe_colimit_components 
+      the_pw_cat_rKe_limit_components   
+      cat_op_simps
+    by simp
+  show ?thesis
+    by 
+      (
+        rule is_cat_limit.is_cat_colimit_op
+          [
+            OF ntcf_cf_comp_is_cat_limit_if_is_iso_functor, 
+            folded the_pw_cat_lKe_colimit_components,
+            unfolded cat_op_simps
+          ]
+      )
+qed
+
 lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe: 
   assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
   shows "the_ntcf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) :
     the_cf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
     \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
 proof-
   interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
   show "the_ntcf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) :
     the_cf_rKe \<alpha> \<TT> \<KK> (the_pw_cat_rKe_limit \<alpha> \<KK> \<TT> \<GG>) \<circ>\<^sub>C\<^sub>F \<KK> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>r\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> \<TT> :
     \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
     by
       (
         rule
           the_ntcf_rKe_is_cat_rKe
             [
               OF
                 assms(1)
                 ntcf_rKe.NTCod.is_functor_axioms 
-                cat_pw_rKe_the_pw_cat_rKe_limit_is_limit[OF assms]
+                cat_pw_rKe_the_pw_cat_rKe_limit_is_cat_limit[OF assms]
             ]
       )
 qed
 
+lemma (in is_cat_pw_lKe) cat_pw_lKe_the_ntcf_lKe_is_cat_lKe:
+  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" and "\<TT> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
+  shows "the_ntcf_lKe \<alpha> \<TT> \<KK> (the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF>) :
+    \<TT> \<mapsto>\<^sub>C\<^sub>F\<^sub>.\<^sub>l\<^sub>K\<^sub>e\<^bsub>\<alpha>\<^esub> the_cf_lKe \<alpha> \<TT> \<KK> (the_pw_cat_lKe_colimit \<alpha> \<KK> \<TT> \<FF>) \<circ>\<^sub>C\<^sub>F \<KK> :
+    \<BB> \<mapsto>\<^sub>C \<CC> \<mapsto>\<^sub>C \<AA>"
+proof-
+  interpret \<TT>: is_functor \<alpha> \<BB> \<AA> \<TT> by (rule assms(2))
+  show ?thesis
+    by 
+      (
+        rule the_ntcf_lKe_is_cat_lKe
+          [
+            OF
+              assms(1,2) 
+              cat_pw_lKe_the_pw_cat_lKe_colimit_is_cat_colimit[OF assms], 
+            simplified
+          ]
+      )
+qed
+
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file